;***************************************************************************
;                                                                          ;
;      EEEEEEEEEE      OOOOOOO       SSSSSSSS              5555555555      ;
;      EE             OO     OO     SS      SS             55              ;
;      EE            OO       OO    SS                     55              ;
;      EEEEEEEE      OO       OO     SSSSSSSS    XXXXXX    555555555       ;
;      EE            OO       OO            SS                     55      ;
;      EE            OO       OO             SS                     55     ;
;      EE            OO       OO             SS                     55     ;
;      EE             OO     OO     SS      SS             55      55      ;
;      EEEEEEEEEE      OOOOOOO       SSSSSSSS               55555555       ;
;                                                                          ;
;***************************************************************************

;EOS-5 COMMENTED ASSEMBLY LISTING.

;VERSION HISTORY

;  2     9908.17     Richard F. Drushel     Fixed description of PCB/DCB-
;                                           wiping code in __SCAN_ACTIVE,
;                                           __HARD_INIT, and __SOFT_INIT.

;  1     9508.08     Richard F. Drushel     Fixed some comments in light of
;                                           Coleco tech manual.  Renamed all
;                                           *public* symbols with Coleco
;                                           names from EOS6 source code.
;                                           Added caveats and disclaimers.

;  0     9208.10     Richard F. Drushel     Original code regenerated from
;                                           personal commented disassembly
;                                           listing 8808.xx.  Binary code
;                                           verified identical to ROM code
;                                           in both R59 and R80 ADAMs.
;                                           Labels reflect absolute address
;                                           locations of code.  Z80-6801
;                                           synch errors and total ADAMnet
;                                           device list from "ADAM Technical
;                                           Manual" (Coleco, 1984).  Some
;                                           comments need to be changed to
;                                           reflect info in the tech manual.

;***************************************************************************

;Source code regenerated 1992 by Richard F. Drushel
;Comments (c) 1988, 1992, 1995, 1999 by Richard F. Drushel
;All rights reserved.
;Source code formatted for Z80ASM+ assembler (SLR)

;***************************************************************************

;Some notes on the proper usage of this assembly listing.

;     This regenerated source code for EOS-5 represents a huge investment
;of time and intellectual effort on my part.  It forms the basis for all
;my operating systems development for the Coleco ADAM.  Writing all the
;comments, with only the partial descriptions available in "The Hacker's
;Guide to ADAM" books (some of them patently *wrong*), taught me how (and
;how *not*) to write Z80 code.  I'm somewhat reluctant to let it out in
;this easy-to-misuse form.  But I'm doing it nonetheless.  The ADAM community
;needs technical information readily available, and everything else is out
;of print (including the ADAM Technical Manual with its source listings
;of EOS-6 and OS-7).

;    For this courtesy, I'd ask a few favors in return.  They'll make me
;feel better, they'll help you become a better programmer, and they'll
;make my job of supporting *your* software easier under the "new" EOS I've
;been working on since 1992, and which has had a partial debut in the
;ADAMserve Serially-Linked Device Protocol.

;     (1)  Respect the integrity of EOS.  Operating systems have defined
;entrances and defined exits, but what goes on in between is a "black box"
;that you're not supposed to fool around in.  Read, memorize, and accept
;as your programming religion the following paragraph from the first page
;of Coleco's EOS-6 source code:

;          This absolute listing was generated to ease software
;          development on ADAM.  This listing provides the location
;          of both released and unreleased entry points.  Released
;          entry points begin immediately in this file with the jump
;          table and end before the first code segment listed.
;          Released entry points include the jump table, common data
;          areas (EOS_COMN), common data tables, and equates which
;          describe the released data structures.  Direct access
;          to code segments is STRONGLY DISCOURAGED and may make
;          your application incompatible with some ADAMs.  There is
;          more than one version of EOS on the market at this time
;          and updates are planned.

;This means:  *ALWAYS* go through the jump table.  Except for the
;actual internal entry points from the jump table (e.g. __READ_BLOCK),
;all other internal labels in my code have the form Annnnn, where nnnnn
;is a number 0-65535.  These are not the Coleco names for these internal
;references, but I've left them in my raw disassembly form, to clearly
;distinguish them from public symbols.  There is no guarantee that these
;internal symbols will have the same value in a future version of EOS;
;the public symbols will *always* be the same.

;     (2)  Don't write directly to the hardware.  Use EOS function calls
;to set the video mode and do device I/O.  Don't access the VDP at the
;port I/O level.  Don't write directly to DCBs to do ADAMnet device I/O.
;If your code bypasses EOS, it can't be supported by an ADAM emulator
;without enormous effort.

;     (3)  If you make your own changes to EOS, as a part of your own
;learning/hacking experience, please *don't* spread them around
;promiscuously.  If you've found an improvement, by all means share
;it with the community; but let's try to keep some control over EOS
;versionitis.  TDOS is bad enough :-)

;     (4)  If you have suggestions for improvement, please let me know.
;Be aware, however, that I've already done alot of the obvious things
;(replacing needless absolute JPs with JRs, importing shorter versions
;of file and device I/O from EOS-7, ADAMnet emulator code for non-
;ADAMnet hardware, EOS RAMdisk).

;     (5)  If you find bugs in my comments, I'd like to hear about them.
;I think I'm a little confused about some of the sound data structures,
;but even the EOS-6 comments are confusing.

;     (6)  Don't make any money off of this, either code or in publishing,
;without asking me first.  The days of commercial gain from ADAM software
;are *over*, as far as I'm concerned.

;     (7)  Have *fun* with your ADAM!

;Richard F. Drushel, Ph.D.
;3353 Mayfield Road
;Cleveland Heights, Ohio  44118-1329 U.S.A.
;(216) 397-0684
;rfd@po.cwru.edu

;***************************************************************************

;Note:  EOS function calls marked with an asterisk (*) indicate direct calls
;to the routine in memory, NOT through the jump table.  This must have been
;done just to frustrate anyone who might try to disassemble it.

;***************************************************************************

EOS_CODE EQU 57344

        ORG   EOS_CODE

;***************************************************************************
;Externals and equates go here.

COLD_START_ADDR  EQU   51200     ;boot block DTA
FCB_S            EQU   54160     ;FCB0
THREE1K_BLKS     EQU   54272     ;DTA0

;***************************************************************************
;EOS Function 78:  WRITE VRAM.
;    On entry, DE=VRAM target address to write, HL=RAM source address of
;    data, BC=number of bytes to write.

__WRITE_VRAM:
        PUSH BC             ;save byte count
        EX DE,HL            ;HL=VRAM target address to write
        CALL A57833         ;ENABLE VRAM WRITE subroutine
        LD L,C              ;L=VDP data port (190) returned by subrt
        POP BC              ;restore byte count
        EX DE,HL            ;HL=RAM source address, E=VDP data port
        LD A,C              ;A=lobyte of byte count
        LD C,E              ;C=VDP data port
        LD D,B              ;D=hibyte of byte count
        INC D               ;D=D+1 (needed for later DEC)
        LD B,A              ;B=lobyte of byte count (for OUTI)
        OR A                ;B=0? (even multiples of 256)
        JR Z,A57366         ;YES, so get next 256
A57360:
        OUTI                ;send (HL) out (C), HL=HL+1, B=B-1
        NOP
        NOP                 ;wait a bit
        JR NZ,A57360        ;B not zero, so keep sending data
A57366:
        DEC D               ;B=0, so one less unit of 256 to send
        JR NZ,A57360        ;keep sending if D not zero
        RET                 ;B and D both zero (count done), so EXIT
;***************************************************************************
;EOS Function 79:  READ VRAM.
;    On entry, DE=VRAM address to read, HL=RAM target address to receive
;    data, BC=number of bytes to read.

__READ_VRAM:
        PUSH BC             ;save byte count
        EX DE,HL            ;HL=VRAM address to read
        CALL A57831         ;ENABLE VRAM READ subroutine
        LD L,C              ;L=VDP data port (190) returned by subrt
        POP BC              ;restore byte count
        EX DE,HL            ;HL=RAM target address, E=VDP data port
        LD A,C              ;A=lobyte of byte count
        LD C,E              ;C=VDP data port
        LD D,B              ;D=hibyte of byte count
        INC D               ;D=D+1 (needed for later DEC)
        LD B,A              ;B=lobyte of byte count
        OR A                ;B=0? (even multiples of 256)
        JR Z,A57392         ;YES, so get next 256
A57386:
        INI                 ;read (C) into (HL), HL=HL+1, B=B-1
        NOP
        NOP                 ;wait a bit
        JR NZ,A57386        ;B not zero, so keep reading data
A57392:
        DEC D               ;B=0, so one less unit of 256 to send
        JR NZ,A57386        ;keep sending if D not zero
        RET                 ;B and D both zero (count done), so EXIT
;***************************************************************************
;EOS Function 80:  WRITE VDP REGISTER 0-7.
;    On entry, B=register number to write (0-7), C=data byte to send.  If
;    register written was 0 or 1, the data byte sent is stored in RAM at
;    64865 (0) or 64866 (1).

__WRITE_REGISTER:
        LD E,C               ;E=data
        LD A,(VDP_CTRL_PORT) ;A=VDP control port (191)
        LD C,A
        OUT (C),E           ;send data out (191)
        LD A,B              ;A=register #
        OR 128              ;set bit 7
        OUT (C),A           ;send register # out (191)
        LD A,B              ;A=register number
        OR A                ;was it register 0?
        LD A,E              ;A=data sent
        JR NZ,A57417        ;NO, but was it register 1?
        LD (VDP_REG_0),A    ;YES, so save register 0 data in RAM
        RET
;***************************************************************************
A57417:
        DEC B               ;
        RET NZ              ;EXIT if register 1 wasn't written
        LD (VDP_REG_1),A    ;save register 1 data in RAM
        RET
;***************************************************************************
;EOS Function 81:  READ VDP REGISTER 8.

__READ_REGISTER:
        LD A,(VDP_CTRL_PORT)   ;A=VDP control port (191)
        LD C,A
        IN A,(C)               ;read port
        LD (VDP_STATUS_BYTE),A ;save it in RAM
        RET
;***************************************************************************
;EOS Function 82:  FILL VRAM WITH 1 CHARACTER (in A).
;    On entry, A=character to fill, DE=number of times to fill, HL=VRAM
;    address to write.

__FILL_VRAM:
        PUSH AF             ;save character
        CALL A57833         ;ENABLE VRAM WRITE subroutine
        POP HL              ;get back character in H
A57438:
        OUT (C),H           ;send char out VDP data port (from subrt)
        DEC DE              ;decrement counter
        LD A,D
        OR E                ;is DE=zero?
        JR NZ,A57438        ;NO, so keep sending
        RET
;***************************************************************************
;EOS Function 83:  INITIALIZE VRAM TABLE.
;   On entry, A=code for which table to initialize:  (0) sprite attribute
;   table, (1) sprite generator table, (2) pattern name table, (3) pattern
;   generator table, (4) color table.  HL=VRAM address of table.

__INIT_TABLE:
        LD C,A
        LD B,0                ;BC=table code
        LD IX,VRAM_ADDR_TABLE ;RAM table of pointers to VRAM tables
        ADD IX,BC
        ADD IX,BC           ;offset code*2 into table
        LD (IX+0),L
        LD (IX+1),H         ;store HL in RAM table
        LD A,(VDP_REG_0)    ;A=current VDP register 0
        BIT 1,A             ;test bit 1
        JR Z,57509          ;set=graphics mode 2 (hires)
        LD A,C              ;clear=any other mode, so get table code
        CP 3                ;pattern generator table?
        JR Z,A57481         ;YES
        CP 4                ;color table?
        JR Z,A57495         ;YES
        JR A57509           ;sprite attrib, gen or patt name tables
;***************************************************************************
A57481:
        LD B,4              ;B=register 4 for Fn80 (PATTERN GENERATOR)
        LD A,L
        OR H                ;is HL=zero?
        JR NZ,A57491        ;NO
        LD C,3              ;YES, so C=3=data to send for Fn80
        JR A57531           ;write it
;***************************************************************************
A57491:
        LD C,7              ;HL<>0, so C=7=data to send for Fn80
        JR A57531           ;write it
;***************************************************************************
A57495:
        LD B,3              ;B=register 3 for Fn80 (COLOR TABLE)
        LD A,L
        OR H                ;is HL=zero?
        JR NZ,A57505        ;NO
        LD C,127            ;YES, so C=127=data to send for Fn80
        JR A57531           ;write it
;***************************************************************************
A57505:
        LD C,255            ;HL<>0, so C=255=data to send for Fn80
        JR A57531           ;write it
;***************************************************************************
A57509:
        LD IY,A57535        ;IY=base of data table
        ADD IY,BC
        ADD IY,BC           ;offset 2*code # into table
        LD A,(IY+0)         ;A=table lobyte (# times to HL=HL/2)
        LD B,(IY+1)         ;B=table hibyte (reg to write in Fn80)
A57523:
        SRL H
        RR L                ;HL=HL/2
        DEC A               ;decrement counter
        JR NZ,A57523        ;not done yet, so keep dividing
        LD C,L              ;done, so C=L=data to send for Fn80
A57531:
        CALL WRITE_REGISTER ;Fn80:  WRITE VDP REGISTER 0-7
        RET
;***************************************************************************
;DATA TABLE FOR Function 83:  INITIALIZE VRAM TABLE.
;                                         VRAM register   divisor 2^n
A57535:
        DB 7,5
                ;sprite attribute table         5           7  (128)
        DB 11,6
                ;sprite generator table         6          11  (2048)
        DB 10,2
                ;pattern name table             2          10  (1024)
        DB 11,4
                ;pattern generator table        4          11  (2048)
        DB 6,3
                ;color table                    3           6  (64)
;***************************************************************************
;EOS Function 84:  PUT TABLE TO VRAM.
;    On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry
;    number in table, IY=number of entries to be moved.

__PUT_VRAM:
        CALL A57557         ;TABLE OFFSET subroutine
        JP WRITE_VRAM       ;Fn78:  WRITE VRAM
;***************************************************************************
;EOS Function 85:  GET TABLE FROM VRAM.
;    On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry
;    number in table, IY=number of entries to be moved.

__GET_VRAM:
        CALL A57557         ;TABLE OFFSET subroutine
        JP READ_VRAM        ;Fn79:  READ VRAM
;***************************************************************************
;TABLE OFFSET subroutine.
;    On entry, A=table code (see Fn83), HL=table address in RAM, DE=entry
;    number in table, IY=number of entries to be moved.  On exit, HL is
;    untouched, DE=offset into RAM table, BC=number of bytes to move.

A57557:
        PUSH IY             ;save # entries to move
        LD C,A              ;save table code
        CP 4                ;color table?
        JR NZ,A57572        ;NO
        LD A,(VDP_REG_0)    ;YES, so A=current register 0
        AND 2               ;mask out all but bit 1
        JR Z,A57591         ;bit 1 cleared
        LD A,C              ;bit 1 set=graphics mode 2; get table code
A57572:
        CP 2                ;pattern name table?
        JR Z,A57591         ;YES
        EX DE,HL            ;NO, so HL=entry number DE (orig. HL safe)
        ADD HL,HL           ;HL*2
        ADD HL,HL           ;HL*4
        OR A                ;sprite attribute table?
        JR Z,A57583         ;YES, so no more offset
        ADD HL,HL           ;HL*8
A57583:
        EX DE,HL            ;result: DE=DE*4 or *8; HL untouched
        EX (SP),HL          ;since IY on stack, HL=IY, old HL on stack
        ADD HL,HL           ;HL*2
        ADD HL,HL           ;HL*4
        JR Z,A57590         ;sprite attrib table? YES=no more offset
        ADD HL,HL           ;HL*8
A57590:
        EX (SP),HL          ;result: stack=IY*4 or *8, HL untouched
A57591:
        LD A,C                ;A=table code
        LD BC,VRAM_ADDR_TABLE ;RAM table of pointers to VRAM tables
        PUSH HL               ;save original entry HL
        LD H,0
        LD L,A              ;HL=table code
        ADD HL,HL           ;HL*2
        ADD HL,BC           ;plus base of RAM table=offset
        LD A,(HL)           ;A=lobyte of address in RAM table
        INC HL              ;point to hibyte
        LD H,(HL)           ;H=hibyte of address in RAM table
        LD L,A              ;HL=VRAM table address
        ADD HL,DE           ;add offset amount in DE computed above
        EX DE,HL            ;DE=offset address in VRAM
        POP HL              ;HL still=entry value (RAM source table)
        POP BC              ;BC from stack=entry IY*4 or *8
        RET
;***************************************************************************
;EOS Function 86:  CALCULATE OFFSET INTO SPRITE ATTRIBUTE TABLE.
;    On entry, D=Y-coordinate of pattern position, E=X-coordinate.  D and E
;    are signed 8-bit numbers (-128 to +127).  On exit, DE=(Y*32)+X.

__CALC_OFFSET:
        PUSH HL
        BIT 7,D             ;D<0? (sign bit set)
        JR Z,A57619         ;YES
        LD H,255            ;NO, so H=255
        JR A57621
;***************************************************************************
A57619:
        LD H,0              ;D<0 signed, so H=0
A57621:
        LD L,D              ;HL=D (sign bit clear) or HL=65280+D (set)
        ADD HL,HL           ;HL*2
        ADD HL,HL           ;HL*4
        ADD HL,HL           ;HL*8
        ADD HL,HL           ;HL*16
        ADD HL,HL           ;HL*32; result is HL=D*32
        BIT 7,E             ;E<0? (sign bit set)
        JR Z,A57635         ;YES
        LD D,255            ;NO, so D=255
        JR A57637
;***************************************************************************
A57635:
        LD D,0              ;E<0 signed, so H=0
A57637:
        ADD HL,DE           ;result is HL=(D*32)+E
        EX DE,HL            ;DE=offset
        POP HL
        RET
;***************************************************************************
;EOS Function 87:  POINT TO PATTERN POSITION.
;    On entry, DE=signed 16-bit number (X-coordinate or Y-coordinate of
;    pattern).  On exit, DE ranges from -128 to +127.

__PX_TO_PTRN_POS:
        PUSH HL
        PUSH BC
        LD B,3              ;number of times to (DE=DE/2)
A57645:
        SRA D
        RR E                ;DE=DE/2
        DJNZ A57645         ;keep dividing 'til B=0
        POP BC
        LD HL,65408         ;HL=1111 1111 1000 0000 binary
        BIT 7,D             ;is DE<0? (sign bit set)
        JR NZ,A57665        ;NO
        ADD HL,DE           ;YES, so HL=HL+DE; was there a carry?
        POP HL              ;restore entry HL
        RET NC              ;no carry, so EXIT
        LD E,127            ;carry, so DE=+127
        RET
;***************************************************************************
A57665:
        LD H,0              ;zero out sign extension in H
        ADD HL,DE           ;HL=HL+DE; was there a carry?
        POP HL              ;restore entry HL
        RET C               ;carry, so EXIT
        LD E,128            ;no carry, so DE=-128
        RET
;***************************************************************************
;EOS Function 88:  LOAD ASCII CHARACTER SET FROM ROM TO VDP.

__LOAD_ASCII:
        LD DE,(PATTRNGENTBL) ;DE=VRAM addr of pattern generator table
        LD HL,0              ;HL=ASCII code of 1st character to load
        LD BC,128            ;# of character patterns to load
                              ;fall thru to Fn77: PUT ASCII CHAR TO VDP
;**************************************************************************
;EOS Function 77:  PUT ASCII CHARACTER PATTERN TO VDP.
;    On entry, HL=code of first character pattern to load, BC=number of
;    patterns, DE=VRAM address of pattern generator table.

__PUT_ASCII:
        ADD HL,HL           ;HL*2
        ADD HL,HL           ;HL*4
        ADD HL,HL           ;HL*8 -- 8 bytes per pattern (offset)
        PUSH BC             ;save BC on stack
        EX (SP),HL          ;effectively, HL=BC, old HL on stack
        ADD HL,HL           ;HL*2
        ADD HL,HL           ;HL*4
        ADD HL,HL           ;HL*8 -- total bytes to load = # char*8
        EX (SP),HL          ;effectively, old HL back, BC*8 on stack
        POP BC              ;BC=BC*8 from stack
        LD IX,0
        ADD IX,SP           ;IX=address of old stack
        LD SP,TEMP_STACK    ;address of temporary stack
        PUSH IX             ;save address of old stack
        LD A,(CUR_BANK)     ;A=current memory configuration
        PUSH AF             ;save it
        LD A,(MEM_CNFG00)   ;memory configuration 0:  EOS -- RAM
        PUSH BC             ;save pattern count
        CALL SWITCH_MEM     ;Fn76:  BANK SWITCH MEMORY (to A)
        POP BC              ;get back pattern count
        PUSH DE             ;save VRAM addr of pattern gen table
        LD DE,(258)         ;DE=addr of char set patterns in EOS ROM
        ADD HL,DE           ;add offset so HL=EOS addr of 1st pattern
        POP DE              ;restore VRAM addr of pattern gen table
        CALL WRITE_VRAM     ;Fn78:  WRITE VRAM
        POP AF              ;get back original memory configuration
        CALL SWITCH_MEM     ;Fn76:  BANK SWITCH MEMORY (to A)
        POP HL              ;get back old stack address
        LD SP,HL            ;point SP at old stack
        RET
;***************************************************************************
;EOS Function 76:  BANK SWITCH MEMORY (to A).

;    On entry, A=memory configuration (0-15).  Memory configurations decode
;    as follows:

;        lower 32K            upper 32K
; 0  SmartWriter or EOS     RAM
; 1  RAM                    RAM
; 2  expansion RAM          RAM
; 3  OS-7 plus 24K RAM      RAM
; 4  SmartWriter or EOS     expansion ROM (center slot)
; 5  RAM                    expansion ROM (center slot)
; 6  expansion RAM          expansion ROM (center slot)
; 7  OS-7 plus 24K RAM      expansion ROM (center slot)
; 8  SmartWriter or EOS     expansion RAM
; 9  RAM                    expansion RAM
;10  expansion RAM          expansion RAM
;11  OS-7 plus 24K RAM      expansion RAM
;12  SmartWriter or EOS     cartridge ROM
;13  RAM                    cartridge ROM
;14  expansion RAM          cartridge ROM
;15  OS-7 plus 24K RAM      cartridge ROM

;    In order to select the SmartWriter ROM, an OUT (63),0 must be executed
;first.  To select the EOS ROM, use OUT (63),2.

__SWITCH_MEM:
        LD B,A
        LD A,(MEM_SWITCH_PORT) ;A=memory switch port (127)
        LD C,A
        OUT (C),B              ;do the switch
        LD A,B
        LD (CUR_BANK),A        ;save new memory configuration as current
        RET
;***************************************************************************
;EOS Function 75:  GET I/O PORTS FROM OS-7.

;    The OS-7 ROM contains the ColecoVision game cartridge operating system.
;    The values retrieved are stored in RAM as follows:

;64551  memory switch port      127
;64552  ADAMnet reset port       63
;64553  VDP control port        191
;64554  VDP data port           190
;64555  game controller 1 port  252
;64556  game controller 2 port  255
;64557  strobe set port         128
;64558  strobe reset port       192
;64559  sound port              255

__PORT_COLLECTION:
        LD A,(CUR_BANK)     ;A=current memory configuration
        PUSH AF             ;save it
        LD A,(MEM_CNFG03)   ;memory configuration 3:
                             ;lower 32K=OS-7 plus 24K RAM
                             ;upper 32K=RAM
        CALL SWITCH_MEM     ;Fn76:  BANK SWITCH MEMORY (to A)
        LD HL,VDP_CTRL_PORT ;HL=RAM address of VDP control port
        LD A,(7491)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM address of VDP data port (64554)
        LD A,(7495)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM addr of game contrl 1 port (64555)
        LD A,(4427)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM addr of game contrl 2 port (64556)
        LD A,(4433)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM address of strobe set port (64557)
        LD A,(4439)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM addr of strobe reset port (64558)
        LD A,(4456)         ;get port from OS-7
        LD (HL),A           ;save it in RAM
        INC HL              ;HL=RAM address of sound port (64559)
        LD A,(398)          ;get port from OS-7
        LD (HL),A           ;save it in RAM
        POP AF              ;restore old memory configuration
        CALL SWITCH_MEM     ;Fn76:  BANK SWITCH MEMORY (to A)
        RET
;***************************************************************************
;EOS Function 89:  WRITE VRAM SPRITE ATTRIBUTE TABLE.
;    On entry, A=number of sprites to write, HL=address of sprite order table
;    in RAM, DE=address of RAM copy of sprite attribute table.

__WR_SPR_ATTRIBUTE:
        PUSH AF
        PUSH HL
        LD HL,(SPRITEATTRTBL) ;HL=VRAM addr of sprite attribute table
        CALL A57833           ;ENABLE WRITE VRAM; return C=VDP data port
        POP HL
        POP AF
        LD B,A              ;save count of sprites to write
A57808:
        LD A,(HL)           ;A=sprite ID # from order table
        ADD A,A             ;A*2
        ADD A,A             ;A*4
        INC HL              ;point to next entry in order table
        PUSH HL             ;save address
        LD L,A
        LD H,0              ;HL=offset into table
        ADD HL,DE           ;DE=offset addr in RAM sprite attr table
        LD A,B              ;restore A=count of sprites to write
        LD B,4              ;4 bytes to send per sprite
A57820:
        OUTI                ;send a byte at (HL) out VDP data port
        NOP
        NOP                 ;wait a bit
        JR NZ,A57820        ;send the next byte
        LD B,A              ;restore B=count of sprites to write
        POP HL              ;HL=address of next entry in order table
        DJNZ A57808         ;send the next sprite
        RET                 ;all requested were sent; exit
;***************************************************************************
;ENABLE VRAM READ/WRITE subroutines.
;    On entry, HL=VRAM address to read/write.  On exit, C=VDP data port (190).
;    Unfortunately, these subroutines have overlapping reading frames:

;    (1)  Function 79 (read VRAM) enters at 57831:

;57831 AF       XOR A         ;zero out A for reads
;57832 C23E40   JP NZ,16446   ;never jumps because ZF=1 after XOR A
                              ;continues at 57835

;    (2)  Functions 78 (write VRAM), 82 (fill VRAM with 1 character (in A)),
;         and 89 (write VRAM sprite attribute table) enter at 57833:

;57831 AFC2                   ;unused
;57833 3E40     LD A,64       ;A=64 for writes; continues at 57835

A57831:
        XOR A
        DB 194
A57833:
        LD A,64
        LD BC,(VDP_CTRL_PORT) ;B=VDP data port, C=VDP control port
        OUT (C),L             ;send lobyte of VRAM address
        OR H                  ;set bit 6 of H (writes) or not (reads)
        OUT (C),A             ;send hibyte of VRAM address
        LD C,B                ;VDP data port in C
        RET
;***************************************************************************
;DATA TABLE FOR Function 90:  READ GAME CONTROLLERS.
;    Offset into the table is the actual data returned by the controller.
;    Value at the offset is the decoded value.

;                   DATA IN:   DECODED TO:
A57846:
        DB 15  ;       0          15 = nothing
        DB 6   ;       1           6
        DB 1   ;       2           1
        DB 3   ;       3           3
        DB 9   ;       4           9
        DB 0   ;       5           0
        DB 10  ;       6          10 = *
        DB 12  ;       7          12 = Super-Action controller button?
        DB 2   ;       8           2
        DB 11  ;       9          11 = #
        DB 7   ;      10           7
        DB 13  ;      11          13 = Super-Action controller button?
        DB 5   ;      12           5
        DB 4   ;      13           4
        DB 8   ;      14           8
        DB 15  ;      15          15 = nothing (this is an error)
;***************************************************************************
;READ AND DEBOUNCE GAME CONTROLLER subroutine.
;    On entry, A=controller to read (0=player 2, 1=player 1).  On exit, D=
;    decoded keypad value (0-15), B=right button status (0=not pressed, 64=
;    pressed), H=left button status (0=not pressed, 64=pressed), L=joystick
;    position, E=previous value of spinner.

A57862:
        LD C,A              ;save controller number to read
        LD A,I              ;get current interrupt status register
                            ;NOTE:  parity flag set if INT disabled
        PUSH AF             ;save interrupt status
        DI                  ;disable maskable INT (if not already)
        LD A,C                    ;restore A=controller to read
        LD BC,(STROBE_SET_PORT)   ;B=strobe reset port, C=strobe set port
        OUT (C),A                 ;read request
        LD D,B                    ;save strobe reset port in D
        LD HL,SPIN_SW0_CT         ;HL=address of spinner 1
        LD BC,(CONTROLLER_0_PORT) ;B=controller 2 port, C=controller 1 port
        OR A                      ;are we reading controller 1 or 2?
        JR NZ,A57887        ;#1, so reset spinner 1
        INC HL              ;#2, so point to spinner 2
        LD C,B              ;C=controller 2 port
A57887:
        XOR A               ;A=0
        LD E,(HL)           ;E=old spinner value
        LD (HL),A           ;new spinner value=0
        LD B,D              ;restore B=strobe reset port
        IN A,(C)            ;read controller port into A
        CPL                 ;1's complement A
        LD H,0
        LD L,A              ;HL=1's complement A
        LD A,C              ;save controller port in A
        LD C,B              ;C=saved strobe reset port
        OUT (C),A           ;debounce controller by sending the port #
        LD C,A              ;save controller port in C
        POP AF              ;restore entry flags
        JP PO,A57907        ;at entry, maskable INTs were disabled,
                            ;so leave them disabled
        EI                  ;otherwise, enable interrupts
A57907:
        LD A,L              ;restore saved 1's complement of 1st read
        PUSH AF             ;save it again
        AND 64              ;mask out all but bit 6
        LD B,A              ;save it in B (RIGHT BUTTON)
        LD A,L              ;restore saved 1's complement of 1st read
        AND 15              ;select low nibble of byte (table offset)
        LD L,A              ;save it in L
        PUSH DE
        LD DE,A57846        ;DE=base of keypad decoding data table
        ADD HL,DE           ;point HL to data in table
        POP DE
        LD D,(HL)           ;D=decoded value from table (KEYPAD)
        IN A,(C)            ;read controller port again
        CPL                 ;1's complement A
        PUSH AF             ;save it
        LD L,A              ;put it in L
        AND 64              ;mask out all but bit 6
        LD H,A              ;save it in H (LEFT BUTTON)
        LD A,L              ;restore saved 1's complement of A
        AND 15              ;select low nibble of byte
        LD L,A              ;save it in L (JOYSTICK)
        POP AF              ;get 1's complement of 2nd read off stack
        LD C,A              ;put it in C
        POP AF              ;get 1's complement of 1st read off stack
        RET                 ;exit
;***************************************************************************
;EOS Function 90:  READ GAME CONTROLLERS.
;    On entry, IX=address of 10-byte RAM table to hold controller data (joy-
;    stick, left button, right button, decoded keypad, spinner for player 2,
;    followed by player 1), A=weird code for which controller(s) to read:
;       BITS 1,0:
;       00   none
;       01   controller 2
;       10   controller 1
;       11   controller 2, then controller 1
;       BIT 7:
;       1    add old EOS spinner value to old in RAM data table
;       0    don't update RAM spinner

;    NOTE:  This routine must be called TWICE in succession with the same
;    controller code in order to update the RAM table ONCE.  See discussion
;    under STORE CONTROLLER DATA IN RAM TABLE subroutine.

;    Coleco programmer documentation for EOS-7 refers to CONTROLLER_0 and
;    CONTROLLER_1.  These in fact correspond to the ports which are marked "2"
;    (player 2) and "1" (player 1) on the ADAM console, respectively.  I will
;    use the console/player designations.

__POLLER:
        LD HL,PERSONAL_DEBOUNCE_TABLE ;HL=base of controller input data in EOS
        LD C,A                        ;save controller read code in C
        AND 1               ;is it controller 2?
        JR Z,A57982         ;NO
        DEC A               ;YES...
        CALL A57956         ;read controller 2
        BIT 1,C             ;do we also read controller 1?
        RET Z               ;NO (clear) so exit having read just #2
A57954:
        LD A,1              ;YES so A=1 (READ/DEBOUNCE code for #1)
A57956:
        PUSH BC             ;resave controller read code
        PUSH HL             ;save EOS table position
        CALL A57862         ;READ/DEBOUNCE GAME CONTROLLER subrt
        LD C,H              ;C=left button status
        LD A,L              ;A=joystick position
        POP HL              ;restore EOS table position
        CALL A57995         ;STORE CONTROLLER DATA IN RAM subroutine
        POP BC              ;restore controller read code
        BIT 7,C             ;update RAM spinner with EOS data?
        JR Z,A57979         ;NO, so exit
        LD A,E              ;YES, so A=old EOS spinner value
        ADD A,(IX+0)        ;add it to RAM spinner
        LD (IX+0),A         ;save new spinner in RAM table
A57979:
        INC IX              ;point to next RAM controller block
        RET
;***************************************************************************
A57982:
        BIT 1,C             ;do we read controller 1?
        RET Z               ;NO (clear), so exit having read nothing
        LD DE,4             ;YES (set), so skip over controller 2
        ADD HL,DE           ;HL=65118 (EOS data for controller 1)
        INC DE              ;length of RAM table entry=5
        ADD IX,DE           ;point IX to RAM table for controller 1
        JP A57954           ;go back
;***************************************************************************
;STORE CONTROLLER DATA IN RAM TABLE subroutine.
;    On entry, HL=address of EOS table for controller data (either player 2
;    or player 1 4-byte block), IX=address of similar RAM table (but 5 bytes
;    per player block, spinner last), A=joystick position, C=left button
;    status, B=right button status, D=keypad status.  On exit, IX points to
;    spinner data byte.  NOTE:  This routine alternately updates either the
;    EOS or the RAM table.  The first call updates EOS, and the second
;    compares the incoming data with that previously stored in EOS.  The RAM
;    table will only be updated if the two match.  Therefore, Function 90
;    must be called TWICE in succession in order to update the RAM table ONCE.

A57995:
        CALL A58007         ;store joystick data (entry A) in RAM
        LD A,C              ;A=left button status
        CALL A58007         ;store it
        LD A,B              ;A=right button status
        CALL A58007         ;store it
        LD A,D              ;A=decoded keypad
A58007:
        CP (HL)             ;compare it with previous value in EOS
        JR NZ,A58015        ;different, so update EOS but not RAM
        LD (IX+0),A         ;same, so update RAM and...
        OR 128              ;set bit 7 of data (make it different)
A58015:
        LD (HL),A           ;update EOS
        INC IX              ;point to next EOS
        INC HL              ;point to next RAM
        RET
;***************************************************************************
;EOS Function 91:  UPDATE SPINNER 1 AND 2.

__UPDATE_SPINNER:
        LD BC,(CONTROLLER_0_PORT) ;B=controller 2 port, C=controller 1 port
        IN A,(C)                  ;read controller 1 port
        LD HL,SPIN_SW0_CT   ;HL=address of spinner 1
        BIT 4,A             ;was it spun? (bit 4 clear)
        JR NZ,A58040        ;NO, so check spinner 2
        AND 32              ;YES, but which way? (bit 5)
        JR NZ,A58039        ;UP (bit 5 set) so increment spinner
        DEC (HL)            ;DOWN (bit 5 clear) so decrement spinner
        DEC (HL)            ;down 2 and up 1 equals down 1
A58039:
        INC (HL)
A58040:
        LD C,B              ;C=controller 2 port
        IN A,(C)            ;read controller 2 port
        INC HL              ;HL=65113 (address of spinner 2)
        BIT 4,A             ;was it spun? (bit 4 clear)
        RET NZ              ;NO, so exit
        AND 32              ;YES, but which way? (bit 5)
        JR NZ,A58053        ;UP (bit 5 set) so increment spinner
        DEC (HL)            ;DOWN (bit 5 clear) so decrement spinner
        RET
;****************************************************************************
A58053:
        INC (HL)            ;increment spinner
        RET
;***************************************************************************
;UPDATE SIMPLE NOTE subroutine.
;    On entry, IX=output table address.  On exit, ZF=1 if the note is over,
;    ZF=0 if not.

A58055:
        LD A,(IX+7)         ;A=freq step size byte from output table
        OR A                ;is it zero?
        JR NZ,A58070        ;NO, so UPDATE FREQUENCY-SWEPT NOTE
        LD A,(IX+5)         ;YES, so A=note length byte
        DEC A               ;one less clock tick; is it zero?
        RET Z               ;YES, so exit
        LD (IX+5),A         ;NO, so save new length in  output table
        RET
;***************************************************************************
;UPDATE FREQUENCY-SWEPT NOTE subroutine.
;    On entry, IX=output table address.  On exit, ZF=1 if the note is over,
;    ZF=0 if not.

A58070:
        PUSH IX             ;save output table address...
        POP HL              ;and get it back in HL
        LD DE,6             ;offset
        ADD HL,DE           ;point to byte IX+6:  freq step period (4
                            ;bits), 1st freq step period (4 bits)
        CALL __DECLSN       ;*Fn92:  DECREMENT LOW NIBBLE OF (HL)
                            ;1st freq step period is decremented
        RET NZ              ;not time to step yet, so exit
        CALL __MSNTOLSN     ;*Fn94:  HIGH NIBBLE OF (HL) TO LOW NIBBLE
                            ;time to step! so move freq step period
                            ;down to lower 4 bits (still in upper 4)
                            ;all later freq steps have this duration
        DEC HL              ;back up to IX+5:  note length
        LD A,(HL)           ;A=note length
        DEC A               ;one less clock tick; is it zero?
        RET Z               ;YES, so exit
        LD (HL),A           ;NO, so save new length in output table
        DEC HL
        DEC HL              ;back up 2 to IX+3:  freq bits F2-F9
        LD A,(IX+7)         ;A=frequency step size
        CALL __ADD816       ;*Fn95:  ADD A TO WORD AT HL
                            ;add the frequency step, also incrementing
                            ;the low freq bits F0-F1 in byte IX+4
        INC HL              ;point to IX+4:  freq bits in low nibble
        RES 2,(HL)          ;clear bit 2 of frequency
        OR 255              ;A=255, ZF=0
        RET
;***************************************************************************
;UPDATE VOLUME-SWEPT NOTE subroutine.
;    On entry, IX=output table address.  On exit, ZF=1 if the note is over,
;    ZF=0 if not.

A58103:
        LD A,(IX+8)         ;A=vol step size/vol step # byte
        OR A                ;is it zero? (unused)
        RET Z               ;YES, so exit
        PUSH IX             ;save output table address...
        POP HL              ;and get it back in HL
        LD DE,9             ;offset
        ADD HL,DE           ;point HL at byte IX+9:  vol step period
                            ;(4 bits), 1st vol step period (4 bits)
        CALL __DECLSN       ;*Fn92:  DECREMENT LOW NIBBLE OF (HL)
                            ;1st vol step period is decremented
        RET NZ              ;not time to step yet, so exit
        CALL __MSNTOLSN     ;*Fn94:  HIGH NIBBLE OF (HL) TO LOW NIBBLE
                            ;time to step!  so move vol step period
                            ;down to low nibble (still in upper)
                            ;all later steps will have this duration
        DEC HL              ;back up to IX+8: vol step size/step #
        CALL __DECLSN       ;*Fn92:  DECREMENT LOW NIBBLE OF (HL)
                            ;one less step; is it zero?
        JR Z,A58149         ;YES, so zero out the byte and exit
        LD A,(HL)           ;NO, so get it back in A (size old, # new)
        AND 240             ;mask out lower 4 bits (leaves size)
        LD E,A              ;save in in A
        DEC HL
        DEC HL
        DEC HL              ;back up 4 to byte IX+4:  volume (4 bits),
        DEC HL              ;low bits of frequency (4 bits)
        LD A,(HL)           ;get it in A
        AND 240             ;mask out lower 4 bits (leaves volume)
        ADD A,E             ;add step size to volume
        LD E,A              ;save it in E
        LD A,(HL)           ;get back vol/freq byte
        AND 15              ;mask out upper 4 bits (leaves freq)
        OR E                ;merge in new volume as upper 4 bits
        LD (HL),A           ;save it back in output table
        OR 255              ;A=255, ZF=0
        RET
;***************************************************************************
A58149:
        LD (HL),0           ;zero out vol step size/step # byte
        RET
;***************************************************************************
;SEND NOTE VOLUME subroutine.
;    On entry, IX=output table address, C=voice-dependent volume base as in
;    the following table:
;       144 [1001 0000] -- voice 1
;       176 [1011 0000] -- voice 2
;       208 [1101 0000] -- voice 3
;       240 [1111 0000] -- noise volume
;       224 [1110 0000] -- periodic noise
;       228 [1110 0100] -- white noise

A58152:
        LD A,(IX+4)         ;A=volume/frequency byte
        BIT 4,C             ;is bit 4 set? (voice 1,2,3, noise vol)
        JR Z,A58163         ;NO, so skip the shifting
        RRCA                ;YES, so get volume
        RRCA
        RRCA
        RRCA                ;volume in lower 4 bits, freq in upper 4
A58163:
        AND 15              ;wipe out upper 4 bits
        OR C                ;add voice-dependent base
        JP A58893           ;SEND DATA (in A) OUT SOUND PORT subrt
;***************************************************************************
;SEND NOTE FREQUENCY subroutine.
;    On entry, IX=output table address, D=voice-dependent frequency base as in
;    the following table:
;       128 [1000 0000] -- voice 1
;       160 [1010 0000] -- voice 2
;       192 [1100 0000] -- voice 3

A58169:
        LD A,(IX+3)         ;A=frequency byte (high 8 bits)
        AND 15              ;mask out upper 4 bits
        OR D                ;merge with voice-dependent frequency base
        CALL A58893         ;SEND DATA (in A) OUT SOUND PORT subrt
        LD A,(IX+3)         ;get back frequency byte
        AND 240             ;this time, mask out lower 4 bits
        LD D,A              ;save it in D
        LD A,(IX+4)         ;A=vol/freq byte (low nibble is freq)
        AND 15              ;mask out upper 4 bits
        OR D                ;merge with other frequency bits
        RRCA
        RRCA
        RRCA
        RRCA                ;effectively, swap nibbles
        JP A58893           ;SEND DATA (in A) OUT SOUND PORT subrt
;***************************************************************************
;EOS Function 92:  DECREMENT LOW NIBBLE OF (HL).
;    On exit, the low nibble of (HL) is decremented, A=new value of low
;    nibble, and ZF=1 if it is now zero.

__DECLSN:
        XOR A               ;A=0
        RRD                 ;move low nibble of (HL) into A
        SUB 1               ;decrement it
        PUSH AF             ;save it with flags
        RLD                 ;move decremented nibble back to (HL)
        POP AF              ;restore nibble value in A with flags
        RET
;***************************************************************************
;EOS Function 93:  DECREMENT HIGH NIBBLE OF (HL).
;    On exit, the high nibble of (HL) is decremented, A=new value of high
;    nibble, and ZF=1 if it is now zero.  This function is not used anywhere
;    in EOS-5.

__DECMSN:
        XOR A               ;A=0
        RLD                 ;move high nibble of (HL) into A
        SUB 1               ;decrement it
        PUSH AF             ;save it with flags
        RRD                 ;move decremented nibble back to (HL)
        POP AF              ;restore nibble value in A with flags
        RET
;***************************************************************************
;EOS Function 94:  HIGH NIBBLE OF (HL) TO LOW NIBBLE.
;    On exit, the high nibble of (HL) is moved to the low nibble, with the
;    original high nibble unchanged.

__MSNTOLSN:
        LD A,(HL)           ;A=memory byte
        AND 240             ;mask out low nibble
        LD B,A              ;save it in B
        RRCA
        RRCA
        RRCA
        RRCA                ;shift the high nibble down to low
        OR B                ;merge in the original high nibble
        LD (HL),A           ;put it back in memory
        RET
;***************************************************************************
;EOS Function 95:  ADD A TO WORD AT HL.
;    On entry, A=data to add, (HL)=lobyte of word, (HL+1)=hibyte of word.  On
;    exit, A is added to word, and HL still points to the lobyte.

__ADD816:
        LD B,0              ;B=0
        BIT 7,A             ;is bit 7 set? (>=128)
        JR Z,A58235         ;NO, so no carry to hibyte
        DEC B               ;YES, so maybe a carry; B=255
A58235:
        ADD A,(HL)          ;add A to lobyte of word
        LD (HL),A           ;save lobyte sum
        INC HL              ;point to hibyte
        LD A,(HL)           ;get it in A
        ADC A,B             ;add B to hibyte for carry
        LD (HL),A           ;save hibyte sum
        DEC HL              ;point back to lobyte
        RET
;***************************************************************************
;GET ADDRESS OF OUTPUT TABLE (in IX) subroutine.
;    On entry, B=code for voice (1=noise, 2=voice1, 3=voice2, 4=voice3).  On
;    exit, IX=address of output table for the requested voice, HL points to
;    hibyte of output table address in voice table.

A58243:
        LD HL,(PTR_TO_LST_OF_SND_ADDRS) ;HL=address of voice list
        DEC HL
        DEC HL              ;back up 2 (gives required offset)
        LD C,B
        LD B,0              ;BC=B
        RLC C               ;BC*2
        RLC C               ;BC*4
        ADD HL,BC           ;offset into voice table
        LD E,(HL)           ;E=lobyte of output table address
        INC HL              ;point to hibyte
        LD D,(HL)           ;D=hibyte of output table address
        PUSH DE             ;save it on stack
        POP IX              ;get it back in IX
        RET
;***************************************************************************
;GET SPECIAL EFFECTS NOTE EXECUTION ADDRESS (in HL) subroutine.
;    On entry, IX=output table address.  On exit, if the current note is
;    special effects, HL=execution address, and A=62.  If there is no note,
;    A=255.  A is unpredictable if the note is anything other than special
;    effects.

A58263:
        LD A,(IX+0)         ;A=current note from output table
        CP 255              ;is it 255? (no note)
        RET Z               ;YES, so exit
        AND 63              ;mask out upper 2 bits
        CP 62               ;is it 62? (special effects)
        RET NZ              ;NO, so exit
        PUSH IX             ;YES, so save output table address...
        POP HL              ;and get it back in HL
        INC HL              ;point to lobyte of execution address
        LD E,(HL)           ;get it in E
        INC HL              ;point to hibyte
        LD D,(HL)           ;get it in D
        EX DE,HL            ;swap execution address into HL
        RET
;***************************************************************************
;EOS Function 96:  SOUND INITIALIZATION.
;    On entry, B=number of voices to initialize (1-4), HL=address of song
;    table with the following format:
;       address of noise note table (lobyte, hibyte)
;       address of noise output table (lobyte, hibyte)
;       ...same for voices 1,2,3.
;    On exit, the current note of each voice in the output table and the saved
;    control sound are set to null (255), and the EOS voice table pointers are
;    set to 58342 (address of another null).

__SOUND_INIT:
        LD (PTR_TO_LST_OF_SND_ADDRS),HL ;save voice table address in RAM
        INC HL
        INC HL              ;point ahead 2 to output table address
        LD E,(HL)           ;get lobyte of address
        INC HL              ;point to hibyte
        LD D,(HL)           ;get hibyte of address
        EX DE,HL            ;save output table address in HL
        LD DE,10            ;length of note entry in table=10 bytes
        LD A,255            ;code for no note being played=255
A58297:
        LD (HL),A           ;save it as first byte of note entry
        ADD HL,DE           ;point to next note in output table
        DJNZ A58297         ;keep initializing 'til all voices done
        LD (HL),0           ;end with a zero to show no more voices
        LD HL,A58342          ;HL=address of null sound (58342)=255
        LD (PTR_TO_S_ON_0),HL ;noise pointer
        LD (PTR_TO_S_ON_1),HL ;voice 1 pointer
        LD (PTR_TO_S_ON_2),HL ;voice 2 pointer
        LD (PTR_TO_S_ON_3),HL ;voice 3 pointer
        LD (SAVE_CTRL),A      ;saved control sound=255
                              ;falls through to Fn97:  SOUND OFF
;***************************************************************************
;EOS Function 97:  SOUND OFF.
;    On exit, the three voices and the noise channel are turned off.

__TURN_OFF_SOUND:
        LD A,(SOUNDPORT)    ;A=sound port
        LD C,A              ;save it in C
        LD A,159            ;volume off voice 1
        OUT (C),A           ;send it
        LD A,191            ;volume off voice 2
        OUT (C),A           ;send it
        LD A,223            ;volume off voice 3
        OUT (C),A           ;send it
        LD A,255            ;volume off noise channel
        OUT (C),A           ;send it
        RET
;***************************************************************************
;NULL SOUND FOR EOS VOICE TABLE INITIALIZATION.

A58342:
        DB 255
;***************************************************************************
;EOS Function 98:  START VOICE.
;    On entry, B=number of the voice to start (1=noise, 2=voice1, 3=voice2,
;    4=voice3.  On exit, the first note of that voice is ready to play.

__PLAY_IT:
        PUSH BC             ;save voice number
        CALL A58243         ;GET ADDR OF OUTPUT TABLE (in IX) subrt
        LD A,(IX+0)         ;A=current note from output table
        AND 63              ;mask out voice bits (leaving song #)
                            ;7-6=voice; 5-0=song #
        POP BC              ;restore voice number
        CP B                ;is it already started? (same)
        RET Z               ;YES, so exit
        LD (IX+0),B         ;NO, so put voice # in output table
        DEC HL              ;back up 2 in song table to get note
        DEC HL              ;table addr (HL set by subroutine)
        LD D,(HL)
        DEC HL
        LD E,(HL)           ;DE=note table address
        LD (IX+1),E
        LD (IX+2),D         ;put it in the output table
        CALL A58610         ;NOTE, REST, REPEAT OR END subroutine
        JR A58490           ;LOAD POINTERS TO VOICE OUTPUT TABLES sub
                            ;RET is here
;***************************************************************************
;EOS Function 99:  SOUND.
;    On entry, all necessary voice tables must have been properly set up and
;    initialized.

__SOUNDS:
        LD A,159              ;off volume voice 1
        LD C,144              ;volume base voice 1
        LD D,128              ;frequency base voice 1
        LD IX,(PTR_TO_S_ON_1) ;IX=address of voice 1 output table
        CALL A58454           ;PLAY A NOTE subroutine
        LD A,191              ;off volume voice 2
        LD C,176              ;volume base voice 2
        LD D,160              ;frequency base voice 2
        LD IX,(PTR_TO_S_ON_2) ;IX=address of voice 2 output table
        CALL A58454           ;PLAY A NOTE subroutine
        LD A,223              ;off volume voice 3
        LD C,208              ;volume base voice 3
        LD D,192              ;frequency base voice 3
        LD IX,(PTR_TO_S_ON_3) ;IX=address of voice 3 output table
        CALL A58454           ;PLAY A NOTE subroutine
        LD A,255              ;off volume noise channel
        LD C,240              ;volume base noise channel
        LD IX,(PTR_TO_S_ON_0) ;IX=address of noise output table
        LD E,(IX+0)           ;get current note in E
        INC E               ;is it 255? (no note)
        JR NZ,A58432        ;NO, it's OK
        CALL A58893         ;YES, so SEND DATA (in A) OUT SOUND PORT
        JR A58469           ;CHECK IF EACH VOICE IS DONE subroutine
;***************************************************************************
A58432:
        CALL A58152         ;SEND NOTE VOLUME subroutine
        LD A,(IX+4)         ;A=note vol/freq byte from output table
        AND 15              ;mask out upper 4 bits (leaves 0 0 F0 F1)
        LD HL,SAVE_CTRL     ;HL=address of saved control sound
        CP (HL)             ;is it the same?
        JR Z,A58469         ;YES, so CHECK IF EACH VOICE IS DONE subrt
        LD (HL),A           ;NO, so update with current value
        LD C,224            ;volume base for periodic nose
        CALL A58152         ;SEND NOTE VOLUME subroutine
        JR A58469           ;CHECK IF EACH VOICE IS DONE subroutine
;***************************************************************************
;PLAY A NOTE subroutine.
;    On entry, IX=address of output table, A=off volume for voice, C=volume
;    base for voice, D=frequency base for voice.  On exit, if the current
;    note=255 (no note), the current voice is turned off.  Otherwise, the
;    note is played.

A58454:
        LD E,(IX+0)         ;E=current note from output table
        INC E               ;is it 255? (no note)
        JR NZ,A58463        ;NO, note is OK
        JP A58893           ;YES, so SEND DATA (in A) OUT SOUND PORT
;***************************************************************************
A58463:
        CALL A58152         ;SEND NOTE VOLUME subroutine
        JP A58169           ;SEND NOTE FREQUENCY subroutine
;***************************************************************************
;CHECK IF EACH VOICE IS DONE subroutine.

A58469:
        LD B,1              ;code for noise channel
        CALL A58243         ;GET ADDR OF OUTPUT TABLE (in IX) subrt
A58474:
        LD A,0              ;A=0
        CP (IX+0)           ;is it the end of the output table?
        RET Z               ;YES, so exit
        CALL A58573         ;NO, so FINISH PLAY AND CHECK IF DONE sub
        LD DE,10            ;length of output table entry
        ADD IX,DE           ;point to next entry
        JR A58474           ;keep going 'til end of table
;***************************************************************************
;LOAD POINTERS TO VOICE OUTPUT TABLES subroutine.

A58490:
        PUSH IX
        LD HL,A58342          ;address of null sound
        LD (PTR_TO_S_ON_0),HL ;init noise pointer
        LD (PTR_TO_S_ON_1),HL ;init voice 1 pointer
        LD (PTR_TO_S_ON_2),HL ;init voice 2 pointer
        LD (PTR_TO_S_ON_3),HL ;init voice 3 pointer
        LD B,1
        CALL A58243         ;GET ADDR OF OUTPUT TABLE (in IX) subrt
A58512:
        LD A,(IX+0)         ;A=current note
        OR A                ;is it zero? (end of output table)
        JR Z,A58549         ;YES, so exit
        INC A               ;NO, but is it 255? (no note)
        JR Z,A58542         ;YES, so point to next note
        LD A,(IX+0)         ;NO, this note's OK, so get it back
        AND 192             ;select voice bits (7-6)
        RLCA
        RLCA
        RLCA                ;effectively, A=voice*2
        LD E,A
        LD D,0              ;DE=voice offset
        LD HL,PTR_TO_S_ON_0 ;base of pointers to voice output tables
        ADD HL,DE           ;select sound (DE=0,1,2,3)
        PUSH IX             ;save output table address...
        POP DE              ;and get it back in DE
        LD (HL),E           ;lobyte of address to EOS table
        INC HL              ;point to next slot
        LD (HL),D           ;hibyte of address to EOS table
A58542:
        LD DE,10            ;length of output table entry
        ADD IX,DE           ;offset to next entry
        JR A58512           ;keep going
;***************************************************************************
A58549:
        POP IX
        RET
;***************************************************************************
;EOS Function 100:  END SPECIAL EFFECTS.
;    On entry, IX=output table address, HL=address of next special effects
;    note, DE=?.

__EFFECT_OVER:
        LD (IX+1),L
        LD (IX+2),H         ;store next note exec addr in output table
        LD A,(DE)           ;get A from (DE)
        AND 63              ;mask out upper 2 bits
        LD B,A              ;save it in B
        LD A,(IX+0)         ;get old note
        AND 192             ;mask out lower 6 bits
        OR B                ;merge with B
        LD (IX+0),A         ;save it back in output table
        JR A58595           ;copy next note to output table
;***************************************************************************
;FINISH PLAY AND CHECK IF DONE subroutine.
;    If the note is special effects, it is executed.  If not, volume and
;    frequency sweeps and note lengths are updated.  If the note is over, the
;    next note from the note table is loaded into the output table. Otherwise,
;    nothing happens.

A58573:
        CALL A58263         ;GET SPECIAL FX NOTE EXEC ADDRESS (in HL)
        CP 255              ;was there a note?
        RET Z               ;NO, so exit
        CP 62               ;YES, but was it special effects?
        JR NZ,A58588        ;NO, a regular note
        LD DE,7             ;YES, it was special effects
        ADD HL,DE           ;offset 7 from address
        JP (HL)             ;play the special effects note
;***************************************************************************
A58588:
        CALL A58103         ;UPDATE VOLUME-SWEPT NOTE subroutine
        CALL A58055         ;UPDATE SIMPLE NOTE subroutine
        RET NZ              ;note not over, so exit
A58595:
        LD A,(IX+0)         ;note is done! get old note
        PUSH AF             ;save it
        CALL A58610         ;NOTE, REST, REPEAT OR END subroutine
        POP BC              ;restore old note
        LD A,(IX+0)         ;get new note from output table
        CP B                ;is it the same voice and kind?
        RET Z               ;YES, so exit
        JR A58490           ;NO, so LOAD POINTERS TO
                            ;VOICE OUTPUT TABLES subroutine
;***************************************************************************
;NOTE, REST, REPEAT OR END subroutine.
;    On entry, IX=address of output table.  On exit, the output table is set
;    up to play the next note.

A58610:
        LD A,(IX+0)         ;A=current note from output table
        AND 63              ;mask out voice bits, leaving song #
        PUSH AF             ;save song #
        LD (IX+0),255       ;initialize current note to null
        LD L,(IX+1)
        LD H,(IX+2)         ;HL=address of next note in note table
        LD A,(HL)           ;A=next note
        LD B,A              ;save it in B
        BIT 5,A             ;is bit 5 set? (REST)
        JR Z,A58660         ;NO, it's a NOTE, REPEAT or END
        PUSH BC             ;YES, so save rest on stack
        AND 31              ;mask out lower 5 bits (get rest length)
        INC HL              ;point to next note in note table
        LD (IX+1),L         ;(rest note is 1 byte long)
        LD (IX+2),H         ;save addr of next note in output table
        LD (IX+4),240       ;put volume in output table
        LD (IX+5),A         ;put length in output table
        LD (IX+7),0
        LD (IX+8),0         ;zero out volume and frequency sweeps
        JP A58860           ;EXIT
;***************************************************************************
;REPEAT SONG.

A58660:
        BIT 4,A             ;is bit 4 set? (END or REPEAT)
        JR Z,A58678         ;NO, it's a NOTE
        BIT 3,A             ;YES, so it bit 3 set? (REPEAT)
        JR Z,A58672         ;NO, so END the voice
        POP BC              ;YES, so restore the voice number
                             ;to REPEAT
        JP __PLAY_IT        ;*Fn98:  START VOICE
;***************************************************************************
;END VOICE.

A58672:
        LD A,255            ;A=null value for output table
        PUSH AF             ;save it
        JP A58860           ;EXIT
;***************************************************************************
;SPECIAL EFFECTS NOTE.
;    If the note is special effects, the programmer must supply the address of
;    a RAM routine to set up the effect.  With no examples to study, I can
;    only guess at how this works.  It seems, however, that this setup routine
;    has 2 parts:  the first (at the address stored in the special effects
;    note) does the setup for playing the current note.  This setup must exit
;    with a RET instruction, which returns to 58712, with another execution
;    address base in IY.  (I don't know if the return IY is the same as the
;    entry IY.)  The exit return address (58860) is saved on the stack, and
;    then a branch is made to IY+7.  Presumably this second routine does some
;    setup for the next special effects note.

A58678:
        AND 60              ;mask out bits 7-6, 1-0
        CP 4                ;is it 4? (bit 2 set=SPECIAL EFFECTS)
        JR NZ,A58723        ;NO, it's something else
        POP IY              ;YES, IY=song #/old flags (pushed as AF)
        PUSH IY             ;save it
        PUSH BC             ;B has 1st byte of note from note table
        INC HL              ;point HL to 2nd byte
        LD E,(HL)           ;E=lobyte of special effects execute addr
        LD (IX+1),E         ;save it in output table
        INC HL              ;point to 3rd byte of note table
        LD D,(HL)           ;D=hibyte of special effects execute addr
        LD (IX+2),D         ;save it in output table
        INC HL              ;point to start of next note in note table
        PUSH IY             ;save song #/old flags
        POP AF              ;restore A=song #, old flags
        PUSH DE             ;save special effects execution address
        POP IY              ;get it back in IY
        LD DE,A58712        ;return address
        PUSH DE             ;save it
        JP (IY)             ;set up the special effects note
;***************************************************************************
A58712:
        LD DE,7             ;DE=7
        ADD IY,DE           ;offset from IY (but what is IY?)
        LD DE,A58860        ;return address
        PUSH DE             ;save it
        JP (IY)             ;do something else...
;***************************************************************************
;SIMPLE NOTE.

A58723:
        PUSH BC             ;save current note
        LD A,B              ;get it in A
        AND 3               ;mask out bits 7-2
        OR A                ;is it zero? (SIMPLE NOTE)
        JR NZ,A58762        ;NO, more complex
        INC HL              ;YES, so point ahead 4 to start of next
        INC HL              ;note in note table
        INC HL              ;(simple note is 4 bytes long)
        INC HL
        LD (IX+1),L
        LD (IX+2),H         ;save addr of next note in output table
        DEC HL              ;back up 1
        LD DE,5             ;DE=5 (offset into output table)
        CALL A58883         ;DE=IX+DE subroutine
        LD BC,3             ;number of bytes to copy
        LDDR                ;copy note table data to output table
        LD (IX+7),0
        LD (IX+8),0         ;zero out unused parts of output table
        JR A58860           ;EXIT
;***************************************************************************
;FREQUENCY-SWEPT NOTE.

A58762:
        CP 1                ;is it 1? (frequency-swept note)
        JR NZ,A58792        ;NO, it's something else
        LD DE,6             ;length of frequency-swept note=6 bytes
        ADD HL,DE           ;get address of next note from note table
        LD (IX+1),L
        LD (IX+2),H         ;save address in output table
        DEC HL              ;back up 1 in note table
        INC E               ;offset=6 into output table
        CALL A58883         ;DE=IX+DE subroutine
        LD BC,5             ;number of bytes to copy
        LDDR                ;copy note table data to output table
        LD (IX+8),0         ;zero out unused parts of output table
        JR A58860           ;EXIT
;***************************************************************************
;VOLUME-SWEPT/NOISE NOTE.
;    Volume-swept notes are voices 1,2,3; noise notes are voice 0.

A58792:
        CP 2                ;is it 2? (VOLUME-SWEPT/NOISE)
        JR NZ,A58834        ;NO, it's something else
        LD DE,6             ;length of note=6 bytes (5 for NOISE)
        ADD HL,DE           ;point to start of next note in note table
        POP AF              ;restore A=byte 1 of current note saved
                            ;way back when (58632) as BC
        PUSH AF             ;save it again
        AND 192             ;mask out bits 5-0; is it noise? (voice 0)
        JR NZ,A58807        ;NO, it's VOLUME-SWEPT
        DEC HL              ;YES, it's NOISE, so back up 1
A58807:
        LD (IX+1),L
        LD (IX+2),H         ;save address of next note in note table
        DEC HL              ;back up 1
        LD E,9              ;offset into output table=9
        CALL A58883         ;DE=IX+DE subroutine
        LD BC,2             ;number of bytes to copy
        LDDR                ;copy vol step bytes to IX+8, IX+9
        XOR A               ;A=0
        LD (DE),A           ;zero out IX+7 (freq step size byte)
        DEC DE              ;back up 2
        DEC DE              ;(freq length, freq step length unchanged)
        LD C,3              ;number of bytes to copy
        LDDR                ;copy note length, volume, frequency
        JR A58860           ;EXIT
;***************************************************************************
;VOLUME- AND FREQUENCY-SWEPT NOTE.

A58834:
        LD DE,8             ;length of vol+freq swept note=8 bytes
        ADD HL,DE           ;point to start of next note in note table
        LD (IX+1),L
        LD (IX+2),H         ;save address of next note in output table
        DEC HL              ;back up 1
        PUSH IX             ;save base of output table...
        POP IY              ;and get it back in IY
        INC E               ;DE=9
        ADD IY,DE           ;offset into output table
        PUSH IY             ;save it...
        POP DE              ;and get it back in DE
        LD BC,7             ;number of bytes to move
        LDDR                ;copy note table data to output table
;***************************************************************************
;SOUND SETUP EXIT.

A58860:
        PUSH IX             ;save address of output table...
        POP HL              ;and get it back in HL
        POP AF              ;restore 1st byte of note from note table
        POP BC              ;restore 1st byte of current note (output)
        CP 255              ;is it null?
        RET Z               ;YES, so exit
        LD D,A              ;NO, so D=1st byte of note from note table
        AND 63              ;mask out voice bits, leaving note type
        CP 4                ;is it 4? (special effects)
        JR NZ,A58877        ;NO
        LD B,62             ;YES, so B=62
A58877:
        LD A,D              ;A=1st byte of note from note table
        AND 192             ;get the voice bits (mask out 5-0)
        OR B                ;set the voice bits
        LD (HL),A           ;save voice/song at byte 0 in output table
        RET
;***************************************************************************
;DE=IX+DE subroutine.
;    On exit, DEout=IYin+DEin.

A58883:
        PUSH IX
        POP IY              ;IY=IX
        ADD IY,DE           ;IY=IY+DE
        PUSH IY
        POP DE              ;DE=IY
        RET
;***************************************************************************
;SEND DATA (in A) OUT SOUND PORT subroutine.
;    On entry and exit, A=data to send.

A58893:
        PUSH BC
        LD B,A              ;B=data to send
        LD A,(SOUNDPORT)    ;get sound port...
        LD C,A              ;in C
        OUT (C),B           ;send the data
        LD A,B              ;restore A with data
        POP BC
        RET
;***************************************************************************
;EOS Function 69:  FIND FILE (NO TYPE).
;    On entry, A=device number, DE=address of filename string (10 characters
;    max for name, then filetype byte , then hex 03), HL=address
;    of 23-byte buffer to contain the directory entry (no date bytes). The
;    routine reads the directory and looks for the first match to the file
;    name string.  The 10-character filenames must match, but the filetype
;    bytes need not.  On exit, if a match was found, the buffer at HL contains
;    the directory entry, BCDE=start block of file,  and ZF=1.  Otherwise,
;    ZF=0 and A=error code.

__FILE_QUERY:
        SCF                 ;set carry flag
        JR A58909           ;jump into next routine
;***************************************************************************
;EOS Function 52:  FIND FILE (WITH TYPE).
;    On entry, A=device number, DE=address of filename string (10 characters
;    max for name, then filetype byte , then hex 03), HL=address
;    of 23-byte buffer to contain the directory entry (no date bytes). The
;    routine reads the directory and looks for the first match to the file
;    name string.  Unlike Fn69, both the 10-character filenames and the file
;    type bytes must match.  On exit, if a match was found, the buffer at HL
;    contains the directory entry, BCDE=start block of file,  and ZF=1.
;    Otherwise, ZF=0 and A=error code.

__QUERY_FILE:
        SCF
        CCF                 ;effectively, clear carry flag
A58909:
        PUSH HL
        PUSH IX
        PUSH AF             ;save device #
        JR C,A58916         ;if Fn69 (find file, no type) A is nonzero
        XOR A               ;if Fn52 (find file, with type) A=0
A58916:
        LD (FILENAME_CMPS),A  ;save A as filename comparison
                              ;zero=type must match, anything else=name only
        POP AF                ;restore A=device #
        LD (USER_BUF),HL      ;save address of directory entry buffer
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD H,D
        LD L,E                ;HL=address of filename string
        CALL __SCAN_FOR_FILE  ;*Fn68:  READ DIRECTORY FOR FILE
        JR NZ,A58957          ;file not found, so error exit ZF=0
        PUSH DE               ;file found! FCB0 bytes 33-34 have offset
        PUSH BC               ;address of matching entry in DTA0
        LD DE,(USER_BUF)      ;DE=directory entry buffer address
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=address of directory entry in DTA0
        LD BC,23            ;23 bytes to move
        LDIR                ;copy directory entry into user buffer
        POP BC
        POP DE               ;BCDE=start block of file
        XOR A                ;A=0, ZF=1
        LD (FILENAME_CMPS),A ;file name comparison=0 (type must match)
A58957:
        POP IX
        POP HL
        RET
;***************************************************************************
;EOS Function 53:  UPDATE DIRECTORY ENTRY.
;    On entry, HL=address of 23-byte buffer containing a directory entry (no
;    date bytes), DE=address of filename string, and FCB0 is set up to read
;    the directory block(s).  On exit, if the file already exists, the entry
;    is updated, A=0 and ZF=1.  Otherwise, ZF=0 and A=error code.

__SET_FILE:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IX
        LD (USER_BUF),HL      ;save address of buffer with new entry
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD H,D
        LD L,E                ;HL=address of filename string
        CALL __SCAN_FOR_FILE  ;*Fn68:  READ DIRECTORY FOR FILE
        JR NZ,A59018          ;file not found, so error exit ZF=0
        LD HL,(USER_BUF)      ;found! so restore HL=entry buffer address
        LD E,(IX+33)          ;Fn68 returns DTA offset addr of match
        LD D,(IX+34)          ;in FCB0 bytes 33-34, so get this in DE
        LD BC,23              ;length of entry
        LDIR                  ;copy updated entry to DTA0
        LD A,(IX+23)          ;A=device #
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JR NZ,A59018        ;write failed, so error exit ZF=0
        XOR A               ;write OK, so exit A=0, ZF=1
A59018:
        POP IX
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 51:  CREATE FILE.
;    On entry, A=device number, BCDE=length of file in bytes (BC=hiword, DE=
;    loword), HL=address of filename string.  If BCDE=0, the file will not
;    attempt to reuse deleted file space, thus allowing for maximum file size.
;    On exit, if create was successful, an entry for the file is added to the
;    directory, "BLOCKS LEFT" is updated, ZF=1 and A=0.  Otherwise, ZF=0 and
;    A=error code.

__MAKE_FILE:
        PUSH IY
        PUSH IX
        PUSH HL
        PUSH DE
        PUSH BC
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD (IX+24),0          ;zero out I/O mode byte
        LD (IX+23),A          ;save device # in FCB0
        LD (USER_NAME),HL     ;save address of filename string
        LD A,B
        OR C                ;is BC=zero?
        JR NZ,A59059        ;NO, so check if file too big
        LD A,E              ;YES, so check DE
        OR D                ;is DE=zero?
        JR NZ,A59059        ;NO, so check if file too big
        SET 5,(IX+24)       ;YES, BCDE=zero, set bit 5 I/O mode byte
                            ;(don't resuse deleted files)
        JR A59091           ;skip size check
;***************************************************************************
;FILE SIZE CHECK.
;    Maximum file size is 254 blocks (leaves 1 for boot and 1 for directory).

A59059:
        LD E,D
        LD D,C
        LD C,B
        LD B,0              ;effectively, BCDE/256
        SRL C
        RR D
        RR E                ;BCDE/512
        SRL C
        RR D
        RR E                ;BCDE/1024 (converts bytes to blocks)
        LD A,C
        OR A                ;is C=0? (blocks less than 255)
        JP NZ,A59794        ;NO, so exit error 11 (FILE TOO BIG)
        INC DE              ;add 1 to DE (if DE was 255, now it's 0)
        LD A,E
        OR D                ;is DE=0? (did we want a 255-block file)
        JP Z,A59794         ;YES, so exit error 11 (FILE TOO BIG)
        LD (BLOCKS_REQ),DE  ;save loword of file length in blocks
;***************************************************************************
A59091:
        LD DE,0
        LD (BLOCKS_REQ+2),DE   ;zero out hiword of file length in blocks
        LD (DIR_BLOCK_NO),DE   ;directory block number=0
        XOR A
        LD (FOUND_AVAIL_ENT),A ;zero out found entry byte
        LD (IX+25),1
        LD (IX+26),A
        LD (IX+27),A
        LD (IX+28),A        ;block to read=1 (directory)
        LD (IX+13),1
        LD (IX+14),A
        LD (IX+15),A
        LD (IX+16),A          ;start block=1
        LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0
        LD (IX+33),E
        LD (IX+34),D        ;save address of DTA0 in FCB0
        LD (BUF_START),DE   ;DTA0 is also buffer start
        LD HL,1024          ;length of buffer=1024
        ADD HL,DE           ;point to end of buffer
        LD (BUF_END),HL     ;save buffer end address
        LD A,(IX+23)        ;A=device #
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=transfer address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A59785          ;read failed, so error exit ZF=0
        LD IY,(FCB_DATA_ADDR) ;read OK, so IY=address of DTA0
        LD A,(IY+12)          ;A=directory size byte from volume entry
        AND 127             ;mask out bit 7
        LD (IX+29),A        ;save max length of directory in FCB0
        LD (IX+30),0
        LD (IX+31),0
        LD (IX+32),0
        CALL A61493         ;VERIFY DIRECTORY CHECK CODE subroutine
        JP NZ,A59785        ;check failed, so error exit ZF=0
        LD B,38             ;check OK, so 38 more entries to check
A59212:
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=address of DTA0 (1st dir entry)
        LD DE,26            ;length of dir entry
        ADD HL,DE           ;point to next entry
        LD (IX+33),L
        LD (IX+34),H        ;save this address in FCB0
A59228:
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=entry address from FCB0
        PUSH HL             ;save it...
        POP IY              ;and get it back in IY
        LD A,(IY+12)        ;A=attribute byte of file
        LD C,A              ;save in in C
        BIT 0,A             ;is bit 0 set? (NOT A FILE)
        JP NZ,A59399        ;YES, so we're at BLOCKS LEFT (last entry)
                            ;see if we found a free entry
        BIT 5,(IX+24)       ;NO, but is bit 5 of I/O mode byte set?
                            ;(don't reuse deleted files)
        JR NZ,A59307        ;YES, so keep looking
        BIT 2,C             ;NO, but is bit 2 of file attribute set?
                            ;(file deleted)
        JR Z,A59292         ;NO, file exists, so check if it has the
                            ;same name as the one we want to create
;***************************************************************************
;DELETED FILE SIZE CHECK.

        LD L,(IY+17)        ;YES, file is deleted, see how big it is
        LD H,(IY+18)        ;HL=file length from entry (blocks free)
        LD DE,(BLOCKS_REQ)  ;DE=file length in blocks (blocks needed)
        OR A                ;clear CF
        SBC HL,DE           ;is free less than needed?
        JR C,A59307           ;YES, not enough blocks, so keep looking
        LD HL,FOUND_AVAIL_ENT ;NO, enough room; HL=found entry byte addr
        BIT 0,(HL)            ;is bit 0 set? (FOUND A FREE ENTRY)
        JR NZ,A59307        ;YES, so keep looking
        SET 0,(HL)          ;NO, so set the found entry byte
        LD E,(IX+25)
        LD D,(IX+26)         ;DE=loword of last block read
        LD (DIR_BLOCK_NO),DE ;save this directory block number
        JR A59307            ;keep looking
;***************************************************************************
;FILENAME CHECK.

A59292:
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=offset into DTA0 of dir entry (name)
        LD HL,(USER_NAME)   ;HL=address of filename string to compare
        CALL A61524         ;FILENAME COMPARISON WITHOUT TYPE subrt
        JP Z,A59798         ;file already exists, so error 6 exit
A59307:
        DJNZ A59212         ;keep looking 'til all checked or end
;***************************************************************************
;MULTIPLE DIRECTORY BLOCK HANDLER.

        LD HL,(BUF_START)   ;all the way through without finding
                            ;BLOCKS LEFT, so there must be more
                            ;directory blocks.  HL=buffer start addr
        LD (IX+33),L
        LD (IX+34),H        ;save buffer start address in FCB0
        INC (IX+25)         ;point to next directory block
        LD A,(IX+32)        ;get hiword/hibyte of dir size
        CP (IX+28)          ;is it less than last block read?
        JP C,A59389         ;YES, so no more directory
        LD A,(IX+31)        ;NO, so get hiword/lobyte of dir size
        CP (IX+27)          ;is it less than last block read?
        JP C,A59389         ;YES, so no more directory
        LD A,(IX+30)        ;NO, so get loword/hibyte of dir size
        CP (IX+26)          ;is it less than last block read?
        JP C,A59389         ;YES, so no more directory
        LD A,(IX+29)        ;NO, so get loword/lobyte of dir size
        CP (IX+25)          ;is it less than last block read?
        JP C,A59389         ;YES, so no more directory
        LD A,(IX+23)        ;NO, still dir blocks left, so A=device #
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=address of DTA0 from FCB0
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A59785        ;read failed, so error exit ZF=0
        LD B,39             ;read OK...
        JP A59228           ;so read 39 more files
;***************************************************************************
;NO MORE DIRECTORY BLOCKS TO READ...DID WE FIND ANYTHING?

A59389:
        LD HL,FOUND_AVAIL_ENT ;HL=address of found entry byte
        BIT 0,(HL)            ;is bit 0 set? (FOUND A FREE ENTRY)
        JP Z,A59802         ;NO, we read the whole thing without luck
                            ;exit error 12
        JR A59406           ;YES, we found something
;***************************************************************************
;"BLOCKS LEFT" REACHED...DID WE FIND ANYTHING?

A59399:
        LD HL,FOUND_AVAIL_ENT ;HL=address of found entry byte
        BIT 0,(HL)            ;is bit 0 set? (FOUND A FREE ENTRY)
        JR Z,A59506         ;NO, but see if there's room at the end
                            ;to make a new one
A59406:
        RES 0,(HL)          ;YES, so clear the found entry byte
        LD L,(IX+25)
        LD H,(IX+26)         ;HL=next block number
        LD DE,(DIR_BLOCK_NO) ;DE=last directory block number read
        OR A                 ;clear CF
        SBC HL,DE            ;HL=HL-DE; is next the same as last?
        LD HL,(BUF_START)    ;HL=address of buffer start
        LD (IX+33),L
        LD (IX+34),H        ;set buffer start address in FCB0
        JR Z,A59468         ;next block same as last, so skip reading
        LD (IX+25),E        ;next block not same as last, so read next
        LD (IX+26),D        ;save new current block in FCB0
        LD BC,0             ;zero out BC
        LD A,(IX+23)        ;A=device #
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A59785        ;read failed; error exit ZF=0
        JR A59468           ;read OK, so get new entry slot
;***************************************************************************
;FIND THE FREE ENTRY (AGAIN) AND UPDATE IT.

A59452:
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=old DTA0 offset address
        LD DE,26            ;length of directory entry
        ADD HL,DE           ;point to next entry
        LD (IX+33),L
        LD (IX+34),H        ;save address in FCB0
A59468:
        PUSH HL             ;save DTA0 offset address...
        POP IY              ;and get it back in IY
        BIT 2,(IY+12)       ;is bit 2 of attribute byte set? (DELETED)
        JR Z,A59452         ;NO, so keep looking
        LD L,(IY+17)        ;YES, so see how big it is
        LD H,(IY+18)        ;HL=length of deleted file in blocks
        LD DE,(BLOCKS_REQ)  ;DE=requested file length in blocks
        PUSH HL
        OR A                ;clear CF
        SBC HL,DE           ;is free length less than requested?
        POP HL
        JR C,A59452         ;YES, not enough room, so keep looking
        LD (BLOCKS_REQ),HL  ;NO, so enough room; save requested length
        CALL A59839         ;SET UP NEW DIRECTORY ENTRY subroutine
        JP NZ,A59785        ;bad filename error 14, so exit
        JP A59761           ;setup OK, so write the new block
;***************************************************************************
;MOVE "BLOCKS LEFT" TO MAKE ROOM FOR NEW ENTRY.

A59506:
        LD A,(IX+28)        ;get hiword/hibyte of last block read
        CP (IX+32)          ;is it less than max dir block?
        JR C,A59544         ;YES, so there's room to add an entry
        LD A,(IX+27)        ;NO, get hiword/lobyte of last block read
        CP (IX+31)          ;is it less than max dir block?
        JR C,A59544         ;YES, so there's room
        LD A,(IX+26)        ;NO, get loword/hibyte of last block read
        CP (IX+30)          ;is it less than max dir block?
        JR C,A59544         ;YES, so there's room
        LD A,(IX+25)        ;NO, get loword/lobyte of last block read
        CP (IX+29)          ;is it less than max dir block?
        JR C,A59544         ;YES, so there's room
        LD A,B              ;NO, we're at the last directory block
        CP 1                ;but is BLOCKS LEFT in slot #39? (last)
                            ;(B was counter from 39 to 0)
        JP Z,A59806         ;YES, so exit error 13 (NO MORE ROOM)
A59544:
        LD L,(IY+17)
        LD H,(IY+18)        ;NO, so HL=length of free space in blocks
        BIT 5,(IX+24)       ;is bit 5 of I/O mode byte set?
                            ;(don't reuse deleted files)
        JR Z,A59568         ;NO, so skip ahead
        LD A,H              ;YES, so there's got to be free space at
        OR L                ;the end; is there any?
        JP Z,A59806         ;NO, so exit error 13 (NO MORE ROOM)
        LD (BLOCKS_REQ),HL  ;YES, so save file length in blocks=HL
        RES 5,(IX+24)       ;clear bit 5 of I/O mode byte
                            ;(no need for this toggle anymore)
A59568:
        LD DE,(BLOCKS_REQ)  ;DE=requested file length in blocks
        OR A                ;clear CF
        SBC HL,DE           ;HL=HL-DE; is free space less than needed?
        JP C,A59806           ;YES, so exit error 13 (NO MORE ROOM)
        LD (NEW_HOLE_SIZE),HL ;NO, there's room, so save difference
                              ;between free and needed as new hole size
        LD HL,BLOCKS_REQ    ;point HL to requested file length
        LD A,(IY+13)        ;A=loword/lobyte of file start block
        ADD A,(HL)          ;add requested file length to get new hole
                            ;start block
        INC HL                ;point to next file start block byte
        LD (NEW_HOLE_START),A ;save new hole start block loword/lobyte
        LD A,(IY+14)          ;get file start block loword/hibyte
        ADC A,(HL)          ;continue addition
        INC HL              ;point to next file start block byte
        LD (65046+1),A      ;save new hole start block loword/hibyte
        LD A,(IY+15)        ;get file start block hiword/lobyte
        ADC A,(HL)          ;continue addition
        INC HL              ;point to next file start block byte
        LD (65046+2),A      ;save new hole start block hiword/lobyte
        LD A,(IY+16)        ;get file start block hiword/hibyte
        ADC A,(HL)          ;continue addition
        INC HL              ;HL=65040 addr of file name str$ pointer
                            ;(this instruction is unnecessary)
        LD (65046+3),A      ;save new hole start block hiword/hibyte
        PUSH BC             ;save dir entry counter
        CALL A59839         ;SET UP NEW DIRECTORY ENTRY subroutine
        POP BC              ;restore dir entry counter
        JP NZ,A59785        ;bad filename error, so exit
        LD L,(IX+33)
        LD H,(IX+34)        ;filename OK, so HL=address of DTA0
        LD DE,26            ;length of dir entry
        ADD HL,DE           ;point to next entry
        LD (IX+33),L
        LD (IX+34),H        ;store new entry address
        DJNZ A59710         ;decrement counter and...
                            ;if "BLOCKS LEFT" was not the last entry
                            ;in the block, then B>0 so put new "BLOCKS
                            ;LEFT" in next dir slot.  If is was the
                            ;last entry, B=0 and we must write the
                            ;current block, then read in the next
                            ;block to put "BLOCKS LEFT" on it
;***************************************************************************
;NEW ENTRY AND "BLOCKS LEFT" ON DIFFERENT BLOCKS.

        LD A,(IX+23)        ;A=device #
        LD HL,(BUF_START)   ;HL=address of buffer start
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JP NZ,A59785        ;write failed, so exit error ZF=0
        LD HL,(BUF_START)   ;HL=address of buffer start
        LD (IX+33),L
        LD (IX+34),H        ;store buffer start address in FCB0
        INC (IX+25)         ;point to next directory block
        LD A,(IX+23)        ;A=device #
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=transfer address (DTA0)
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JR NZ,A59785        ;read failed, so error exit ZF=0
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=start of DTA0 (first dir entry)
;***************************************************************************
;UPDATE "BLOCKS LEFT" ENTRY.

A59710:
        PUSH HL               ;save address of dir entry...
        POP IY                ;and get it back in IY
        LD HL,(NEW_HOLE_SIZE) ;HL=new hole size in blocks
        LD (IY+17),L
        LD (IY+18),H          ;save it in dir entry (blocks used)
        LD A,(NEW_HOLE_START) ;A=new hole start block loword/lobyte
        LD (IY+13),A          ;save it in dir entry (start block)
        LD A,(65046+1)      ;A=new hole start block loword/hibyte
        LD (IY+14),A        ;save it in dir entry
        LD A,(65046+2)      ;A=new hole start block hiword/lobyte
        LD (IY+15),A        ;save it in dir entry
        LD A,(65046+3)      ;A=new hole start block hiword/hibyte
        LD (IY+16),A        ;save it in dir entry
        LD (IY+12),1        ;set file attribute to 1 (NOT A FILE)
        PUSH IY             ;save dir entry address...
        POP DE              ;and get it back in DE
        LD HL,A62504        ;start transfer address=BLOCKS LEFT data
                            ;from EOS RAM table
        LD BC,12            ;length of name
        LDIR                ;move BLOCKS LEFT entry to DTA0
A59761:
        LD A,(IX+23)        ;A=device #
        LD HL,(BUF_START)   ;HL=buffer start address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JR NZ,A59785        ;write failed, so exit error ZF=1
        XOR A               ;create file successful, so A=0, ZF=1
A59785:
        OR A                ;update ZF for OK or error
        POP BC
        POP DE
        POP HL
        POP IX
        POP IY
        RET
;***************************************************************************
A59794:
        LD A,11             ;FILE TOO BIG error
        JR A59785
;***************************************************************************
A59798:
        LD A,6              ;FILE ALREADY EXISTS error
        JR A59785
;***************************************************************************
A59802:
        LD A,12             ;DIRECTORY FULL error
        JR A59785
;***************************************************************************
A59806:
        LD A,13             ;NO MORE ROOM error
        JR A59785
;***************************************************************************
;CHECK FILENAME LENGTH subroutine.
;    On entry, HL=address of filename string, terminated with hex 03.  On
;    exit, if the string is at least 1 and less than 12 characters long, then
;    BC=length of string, A=0 and ZF=1.  Otherwise, ZF=0 and A=14 (BAD FILE
;    NAME error).

A59810:
        PUSH HL
        LD B,12             ;max length of filename string=12
        LD C,1              ;initialize character counter
A59815:
        LD A,(HL)           ;get a character
        CP 3                ;is it hex 03? (logical end)
        JR Z,A59829         ;YES, but were there other characters?
        INC C               ;NO, so increment counter
        INC HL              ;point to next character
        DJNZ A59815         ;keep going 'til 12 are examined;
                            ;if there are too many, we fall through...
A59824:
        LD A,14             ;A=14 (BAD FILE NAME error)
        OR A                ;ZF=0 for error exit
        POP HL
        RET
;***************************************************************************
A59829:
        LD A,C              ;A=character count
        CP 1                ;was it just 1?
        JR Z,A59824         ;YES, so too few characters error
        LD B,0              ;NO, string OK, so zero out B (BC=count)
        XOR A               ;A=0, ZF=1 for OK exit
        POP HL
        RET
;***************************************************************************
;SET UP NEW DIRECTORY ENTRY subroutine.
;    On entry, IY=offset address of entry in DTA0.  On exit, if the filename
;    was too long or short, ZF=1 and A=14 (BAD FILENAME error).  Otherwise,
;    the new entry is written to DTA0 and ZF=1, A=0.

A59839:
        PUSH IY             ;save entry offset address...
        POP DE              ;and get it back in DE
        LD HL,(USER_NAME)   ;HL=address of file name string
        CALL A59810         ;CHECK FILENAME LENGTH subroutine
        JP NZ,A59903        ;too long or short, so error 14 exit
        LDIR                ;name OK, so move filename string to DTA0
                            ;length in BC returned by check subroutine
        LD A,16             ;file attribute=00010000 (user file)
        LD (IY+12),A        ;set it into directory entry
        LD BC,(BLOCKS_REQ)  ;BC=requested length of file
        LD (IY+17),C
        LD (IY+18),B        ;set file length in dir entry
        LD (IY+19),1
        LD (IY+20),0        ;used length=1
        LD (IY+21),0
        LD (IY+22),0        ;last byte count=0
        LD A,(EOS_YEAR)     ;A=current file creation year
        LD (IY+23),A        ;set it into dir entry
        LD A,(EOS_MONTH)    ;A=current file creation month
        LD (IY+24),A        ;set it into dir entry
        LD A,(EOS_DAY)       ;A=current file creation day
        LD (IY+25),A        ;set it into dir entry
        XOR A               ;A=0, ZF=1 for OK exit
A59903:
        RET
;***************************************************************************
;EOS Function 48:  OPEN FILE.
;    On entry, A=device number, HL=address of filename string, B=I/O mode.
;    I/O mode decodes as follows:  1=read, 2=write, 3=random (read/write),
;    4=execute.  The file must have already been created with Fn51 (create
;    file).  On exit, if the open was successful, ZF=1 and A=file number.
;    If the file was not opened for write alone, the DTA contains the first
;    block of the file.  If the opened file is only 1 block long, bit 7 of
;    the FCB I/O mode byte (24) is set.  If the open was unsuccessful, ZF=0
;    and A=error code.

__OPEN_FILE:
        PUSH IY
        PUSH HL
        PUSH IX
        PUSH DE
        PUSH AF
        PUSH BC
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD DE,35              ;length of FCB=35
        ADD IX,DE             ;point IX to FCB1
        LD IY,(FCB_DATA_ADDR) ;IY=address of DTA0
        LD DE,1024            ;length of DTA=1024
        ADD IY,DE           ;point to DTA1
        LD B,1              ;file number 1
A59932:
        LD A,(IX+24)        ;get I/O mode byte from FCB
        OR A                ;is this FCB already in use?
        JR Z,A59966         ;NO, so we'll use it
        LD DE,35            ;YES, so point to next FCB and DTA
        ADD IX,DE           ;IX=address of next FCB
        LD DE,1024
        ADD IY,DE           ;IY=address of next DTA
        INC B               ;next file number...
        LD A,B              ;in A
        CP 3                ;is it 3?
        JR C,A59932         ;NO, so we've still got FCBs to look at
        POP BC              ;YES, so all FCBs in use, error exit
        POP AF
        POP DE
        POP IX
        POP HL
        POP IY
        LD A,7              ;A=7 (TOO MANY OPEN FILES error)
        OR A                ;clear ZF for error exit
        RET
;***************************************************************************
A59966:
        LD (BUF_START),IY   ;save DTA as buffer start
        POP AF              ;restore entry I/O mode (from BC)
        LD (IX+24),A        ;save it in FCB
        POP AF              ;restore device number
        LD (IX+23),A        ;save it in FCB
        PUSH BC             ;save file number (in B)
        PUSH HL             ;save filename string address...
        POP DE              ;and get it back in DE
        PUSH IX             ;save FCB address...
        POP HL              ;and get it back in HL
        LD A,(IX+23)        ;A=device #
        CALL __QUERY_FILE   ;*Fn52:  FIND FILE (WITH TYPE)
        JP NZ,A60152        ;file not found, so error exit ZF=0
        CALL __MODE_CHECK   ;found!  so *Fn67:  CHECK FILE I/O MODE
        JP NZ,A60152        ;check failed, so error exit ZF=0
;***************************************************************************
;CALCULATE LAST BLOCK OF FILE.
;    Adds used length (1 word, bytes 19-20) to start block (2 words, bytes
;    13-16) and saves 2-word result (bytes 29-32).  Since this sum is the
;    block AFTER the last block, 1 is subtracted from the 2 words at 29-32.

        LD A,(IX+19)        ;check OK, so get lobyte of used length
        ADD A,(IX+13)       ;add it to loword/lobyte of start block
        LD (IX+29),A        ;save it in FCB (last block loword/lobyte)
        LD A,(IX+14)        ;get loword/hibyte of start block
        ADC A,(IX+20)       ;add it to hibyte of used length
        LD (IX+30),A        ;save it in FCB (last block loword/hibyte)
        LD A,(IX+15)        ;get hiword/lobyte of start block
        ADC A,0             ;propagate any carry
        LD (IX+31),A        ;save it in FCB (last block hiword/lobyte)
        LD A,(IX+16)        ;get hiword/hibyte of start block
        ADC A,0             ;propagate any carry
        LD (IX+32),A        ;save it in FCB (last block hiword/hibyte)
        LD A,(IX+29)        ;get last file block loword/lobyte
        SUB 1               ;subtract 1
        LD (IX+29),A        ;save it back in FCB
        LD A,(IX+30)        ;get last file block loword/hibyte
        SBC A,0             ;propagate any carry
        LD (IX+30),A        ;save it back in FCB
        LD A,(IX+31)        ;get last file block hiword/lobyte
        SBC A,0             ;propagate any carry
        LD (IX+31),A        ;save it back in FCB
        LD A,(IX+32)        ;get last file block hiword/hibyte
        SBC A,0             ;propagate any carry
        LD (IX+32),A        ;save it back in FCB
;***************************************************************************
        LD DE,(BUF_START)   ;get buffer start address (actually DTAn)
        LD (IX+33),E
        LD (IX+34),D        ;save it in FCB
        LD A,(IX+13)        ;get loword/lobyte of start block
        LD (IX+25),A        ;save it in FCB
        LD A,(IX+14)        ;get loword/hibyte of start block
        LD (IX+26),A        ;save it in FCB
        LD A,(IX+15)        ;get hiword/lobyte of start block
        LD (IX+27),A        ;save it in FCB
        LD A,(IX+16)        ;get hiword/hibyte of start block
        LD (IX+28),A        ;save it in FCB
        LD A,(IX+24)        ;get I/O mode byte
        AND 7               ;mask out bits 7-3
        CP 2                ;is it 2? (open for write alone)
        JR Z,A60147         ;YES, so exit without reading 1st block
        XOR A               ;NO, so A=0
        CP (IX+20)          ;is hibyte of used length=0?
                            ;(used length less than 256 blocks?)
        JR NZ,A60124        ;YES, so read in 1st block of file
        INC A               ;NO, so A=1
        CP (IX+19)          ;is lobyte of used length=1?
                            ;(file is [256*n]+1 blocks long, n>0)
        JR NZ,A60124        ;NO, so read in 1st block of file
        SET 7,(IX+24)       ;YES, so set bit 7 of I/O mode byte
                            ;before reading 1st block of file
                            ;(last physical block of file is in DTA)
A60124:
        LD A,(IX+23)        ;A=device #
        LD HL,(BUF_START)   ;HL=buffer start address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JR NZ,A60152        ;read failed, so error exit ZF=0
A60147:
        XOR A               ;A=0 for OK exit
        POP BC              ;restore file number (in B)
        LD A,B              ;pass it back from subroutine in A
        JR A60157           ;exit OK ZF=1
;***************************************************************************
A60152:
        LD (IX+24),0        ;zero out I/O mode byte (disallocate FCB)
        POP BC
A60157:
        POP DE
        POP IX
        POP HL
        POP IY
        RET
;***************************************************************************
;EOS Function 49:  CLOSE FILE.
;    On entry, A=file number.  On exit, if the close was successful, ZF=1 and
;    A=0.  If the file was opened for writing, the contents of the DTA are
;    written to the file, and the directory entry updated.  If the close was
;    unsuccessful, ZF=0 and A=error code.

__CLOSE_FILE:
        PUSH IX
        PUSH HL
        PUSH DE
        PUSH BC
        OR A                ;file number 0?
        JR Z,A60252         ;YES, so BAD FILE NUMBER error
        CP 3                ;file number less than 3?
        JR NC,A60252        ;NO, so BAD FILE NUMBER error
        LD B,A                ;YES, file number OK, so save it in B
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
A60184:
        LD DE,35            ;length of FCB=35
        ADD IX,DE           ;IX=address of next FCB
        LD DE,1024          ;length of DTA
        ADD HL,DE           ;point HL to next file DTA
        DJNZ A60184         ;keep going 'til we're there
        LD A,(IX+24)        ;we're there!  A=I/O mode byte from FCB
        OR A                ;is it zero? (FCB not in use)
        JR Z,A60252         ;YES, so no file to close! exit error
        AND 64              ;NO, there's a file to close; bit 6 set?
                            ;(data in DTA waiting to be written)
        JR Z,A60242            ;NO, so just disallocate FCB and exit
        LD (FILE_NAME_ADDR),IX ;YES, so we have to write the last block
                               ;to the file.
                               ;set address of filename at start of FCB
        LD A,(IX+23)        ;A=device #
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JR NZ,A60261        ;write failed, so error exit ZF=0
        LD A,(IX+23)        ;write OK, so restore A=device #
        PUSH IX             ;save FCB address...
        POP HL                 ;and get it back in HL
        LD DE,(FILE_NAME_ADDR) ;DE=address of filename
        CALL __SET_FILE        ;*Fn53:  UPDATE DIRECTORY ENTRY
A60242:
        LD (IX+24),0        ;disallocate FCB by zeroing out I/O mode
        POP BC
        POP DE
        POP HL
        POP IX
        RET
;***************************************************************************
A60252:
        POP BC
        POP DE
        POP HL
        POP IX
        LD A,9              ;A=9 (BAD FILE NUMBER error)
        OR A                ;clear ZF for error exit
        RET
;***************************************************************************
A60261:
        POP BC
        POP DE
        POP HL
        POP IX
        OR A                ;clear ZF for other error exit (A=code)
        RET
;***************************************************************************
;EOS Function 50:  RESET FILE.
;    On entry, A=file number.  On exit, if reset was successful, ZF=1 and A=0.
;    The current DTA is written to the file (if opened for write), and then
;    the first block of the file is read into the DTA (if not opened for
;    write alone).  If reset failed, ZF=0 and A=error code.

__RESET_FILE:
        PUSH IX
        PUSH DE
        PUSH BC
        PUSH HL
        OR A                ;file number zero?
        JP Z,A60423         ;YES, so BAD FILE NUMBER error
        CP 3                ;file number less than 3?
        JP NC,A60423        ;NO, so BAD FILE NUMBER error
        LD B,A                ;YES, file number OK, so save it in B
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
A60290:
        LD DE,35            ;length of FCB=35
        ADD IX,DE           ;point IX to next FCB
        LD DE,1024          ;length of DTA=1024
        ADD HL,DE           ;point HL to next file DTA
        DJNZ A60290         ;keep going 'til we're there
        LD A,(IX+24)        ;we're there! A=I/O mode byte from FCB
        OR A                ;is it zero? (FCB not in use)
        JR Z,A60423         ;YES, so no file to reset!  error exit
        AND 64              ;NO, there's a file to reset; bit 6 set?
                            ;(data in DTA waiting to be written)
        JR Z,A60335         ;NO, so skip ahead
        LD A,(IX+23)        ;YES, so write the data; A=device #
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JR NZ,A60432        ;write failed, so error exit ZF=0
        RES 6,(IX+24)       ;write OK, so clear bit 6
                            ;(no data waiting to write)
A60335:
        RES 7,(IX+24)       ;clear bit 7
                            ;(last block of file not in DTA)
        LD A,(IX+13)        ;get loword/lobyte of start block
        LD (IX+25),A        ;save it in FCB
        LD A,(IX+14)        ;get loword/hibyte of start block
        LD (IX+26),A        ;save it in FCB
        LD A,(IX+15)        ;get hiword/lobyte of start block
        LD (IX+27),A        ;save it in FCB
        LD A,(IX+16)        ;get hiword/hibyte of start block
        LD (IX+28),A        ;save it in FCB
        LD (IX+33),L
        LD (IX+34),H        ;save DTA (from HL) in FCB
        LD A,(IX+24)        ;get I/O mode byte
        AND 7               ;mask out upper 5 bits
        CP 2                ;is it 2? (open for write alone)
        JR NZ,A60396        ;NO, so read in first block of the file
        LD (IX+21),0        ;YES,so...
        LD (IX+22),0        ;set last byte to zero
        LD (IX+19),1
        LD (IX+20),0        ;set used length to 1 block
        JR A60416           ;skip first block read and exit OK
;***************************************************************************
A60396:
        LD A,(IX+23)        ;A=device #
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JR NZ,A60432        ;read failed, so error exit ZF=0
A60416:
        POP HL              ;read OK, so exit
        POP BC
        POP DE
        POP IX
        XOR A               ;A=0, ZF=1 for OK exit
        RET
;***************************************************************************
A60423:
        POP HL
        POP BC
        POP DE
        POP IX
        LD A,9              ;A=9 (BAD FILE NUMBER error)
        OR A                ;clear ZF for error exit
        RET
;***************************************************************************
A60432:
        POP HL
        POP BC
        POP DE
        POP IX
        OR A                ;clear ZF for error exit (A=code)
        RET
;***************************************************************************
;EOS Function 54:  READ FILE.
;    On entry, A=file number, BC=number of bytes to read from the file, HL=
;    address of read buffer to receive the data (not the same as file manager
;    DTA).  The file must already have been opened by Fn48 (open file). On
;    exit, if the read was successful, ZF=1, A=0, BC=same as entry, and FCB
;    bytes 33-34 point to the end of the read buffer.  Otherwise, ZF=0, A=
;    error code.  If A=9 (BAD FILE NUMBER) or A=10 (INPUT PAST END), BC=number
;    of bytes actually read from the file; for other errors, BC is unknown.

__READ_FILE:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IX
        LD (USER_BUF),HL    ;save read buffer address
        LD (BYTES_REQ),BC   ;save bytes requested to read
        LD (FNUM),A         ;save file number
        LD (BYTES_TO_GO),BC ;set bytes left to read=bytes requested
        OR A                ;file number zero?
        JP Z,A60799         ;YES, so BAD FILE NUMBER error
        CP 3                ;file number less than 3?
        JP NC,A60799        ;NO, so BAD FILE NUMBER error
        LD B,A                ;YES, so B=file number (offset counter)
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
A60475:
        LD DE,35            ;length of FCB=35
        ADD IX,DE           ;point IX to next FCB
        LD DE,1024          ;length of DTA=1024
        ADD HL,DE           ;point HL to next file DTA
        DJNZ A60475         ;keep going 'til we're there
        LD (BUF_START),HL   ;we're here! save DTA as buffer start addr
        ADD HL,DE           ;compute buffer end address...
        LD (BUF_END),HL     ;and save it (buffer is 1024 bytes long)
        PUSH IX             ;save FCB address...
        POP HL              ;and get it back in HL
        CALL __MODE_CHECK   ;*Fn67:  CHECK FILE I/O MODE
        JP NZ,A60801        ;check failed, so error exit ZF=0
;***************************************************************************
;COPY DATA FROM DTA TO READ BUFFER.
;    Data is copied 1024 bytes at a time, except when fewer are requested.
;    At the end each 1024-byte transfer, the read buffer start address (65030)
;    is adjusted upward for the next copy.

A60502:
        BIT 7,(IX+24)       ;check OK; was bit 7 of I/O mode byte set?
                            ;(last physical block of file in DTA)
        JP NZ,A60715        ;YES, so INPUT PAST END CHECK
        LD HL,(BUF_END)     ;NO, so HL=buffer end address
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=DTA start from FCB
        OR A                ;clear CF
        SBC HL,DE           ;HL=buffer size (end-start); is it zero?
        JR Z,A60560         ;YES, so we're done with this block
                            ;read in the next one
        LD B,H              ;NO, so keep working with current block
        LD C,L              ;BC=HL (buffer size)
        LD DE,(BYTES_TO_GO) ;DE=bytes left to read
        OR A                ;clear CF
        SBC HL,DE           ;compare buffer size with bytes left:
                            ;are there more bytes than buffer?
        JP NC,A60650        ;NO, so read the last bytes and exit
        LD HL,(BYTES_TO_GO) ;YES, so restore HL=to bytes left to read
        OR A                ;clear CF
        SBC HL,BC           ;HL=new bytes left (old-buffer size)
        LD (BYTES_TO_GO),HL ;save new bytes left
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=DTA from FCB
        LD DE,(USER_BUF)    ;DE=read buffer address
        LDIR                ;move BC bytes from DTA to read buffer
                            ;(remember, BC=buffer size)
        LD (USER_BUF),DE    ;set new read buffer start=old end
;***************************************************************************
;READ NEXT BLOCK OF FILE.
;    This only occurs if more than 1024 bytes are requested from the file.

A60560:
        LD HL,(BUF_START)   ;HL=buffer start address
        LD (IX+33),L
        LD (IX+34),H        ;store buffer start address in FCB
        INC (IX+25)         ;point to next block of file
        JR NZ,A60587        ;we can stop if not zero
        INC (IX+26)         ;sorry, must propagate carry
        JR NZ,A60587        ;we can stop if not zero
        INC (IX+27)         ;sorry, must propagate carry
        JR NZ,A60587        ;we can stop if not zero
        INC (IX+28)         ;sorry, must propagate carry
A60587:
        LD A,(IX+23)        ;A=device #
        LD HL,(BUF_START)   ;HL=buffer start address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A60801        ;read failed, so error exit ZF=0
        LD A,(IX+32)        ;read OK, get hiword/hibyte of last block
        CP (IX+28)          ;is it same as current?
        JR NZ,A60647        ;NO, so more blocks to read
        LD A,(IX+31)        ;YES, so get hiword/lobyte of last block
        CP (IX+27)          ;is it same as current?
        JR NZ,A60647        ;NO, so more blocks to read
        LD A,(IX+30)        ;YES, so get loword/hibyte of last block
        CP (IX+26)          ;is it same as current?
        JR NZ,A60647        ;NO, so more blocks to read
        LD A,(IX+29)        ;YES, so get loword/lobyte of last block
        CP (IX+25)          ;is it same as current?
        JR NZ,A60647        ;NO, so more blocks to read
        SET 7,(IX+24)       ;YES, so the last physical block of the
                            ;file has been read in.
                            ;set bit 7 of I/O mode byte to flag this
A60647:
        JP A60502           ;keep reading 'til all bytes read
;***************************************************************************
;COPY LAST 1024 BYTES (OR LESS) OF DATA TO READ BUFFER.

A60650:
        LD A,(IX+32)        ;get hiword/hibyte of last block
        CP (IX+28)          ;is it same as current?
        JR NZ,A60682        ;NO, so copy rest of data
        LD A,(IX+31)        ;YES, so get hiword/lobyte of last block
        CP (IX+27)          ;is it same as current?
        JR NZ,A60682        ;NO, so copy rest of data
        LD A,(IX+30)        ;YES, so get loword/hibyte of last block
        CP (IX+26)          ;is it same as current?
        JR NZ,A60682        ;NO, so copy rest of data
        LD A,(IX+29)        ;YES, so get loword/lobyte of last block
        CP (IX+25)          ;is it same as current?
        JR Z,A60711         ;NO, but it's the last block we'll read
                            ;copy and exit
A60682:
        LD BC,(BYTES_TO_GO) ;YES, it's the last block, BC=bytes left
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=transfer start from FCB
        LD DE,(USER_BUF)    ;DE=read buffer start address
        LDIR                ;move rest of data to read buffer
        LD (IX+33),L
        LD (IX+34),H        ;set FCB pointer to end of read buffer
        POP IX
        POP HL
        POP DE
        POP BC
        XOR A               ;A=0, ZF=1 for OK exit
        RET
;***************************************************************************
;INPUT PAST END CHECK.
;    If more bytes have been requested than the file is long, error 10 (I/O
;    PAST END) is returned, with BC=number of bytes actually read.

A60711:
        SET 7,(IX+24)       ;set bit 7 of I/O mode byte
                            ;(last physical block of file is in DTA)
A60715:
        LD HL,(BUF_START)   ;HL=buffer start address
        LD E,(IX+21)
        LD D,(IX+22)        ;DE=last byte count from FCB
        ADD HL,DE           ;HL=computed address of buffer end
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=transfer start address from FCB
        OR A                ;clear CF
        SBC HL,DE           ;HL=number of bytes left to copy
        LD B,H
        LD C,L              ;save byte count in BC; was it zero?
        JR Z,A60780         ;YES, so exit error 10 (I/O PAST END)
        LD DE,(BYTES_TO_GO) ;NO, so get bytes left to read
        OR A                ;clear CF
        SBC HL,DE           ;is the # of bytes to copy from DTA less
                            ;than total # of bytes left to read?
        JR NC,A60682        ;NO (probably equal), so finish copy and
                            ;exit OK
        LD HL,(BYTES_TO_GO) ;YES, but this is an error; copy what data
                            ;we have to read buffer and exit
                            ;reset HL=bytes left to read
        OR A                ;clear CF
        SBC HL,BC           ;(old total bytes left)-(bytes left in
                            ;1024-byte buffer)=(new total bytes left)
        LD (BYTES_TO_GO),HL ;save new bytes left to read
        LD L,(IX+33)
        LD H,(IX+34)        ;get transfer start from FCB
        LD DE,(USER_BUF)    ;DE=read buffer address
        LDIR                ;copy data to from DTA to read buffer
        LD HL,(BYTES_REQ)   ;HL=bytes requested to read
        LD BC,(BYTES_TO_GO) ;BC=bytes left to read
        OR A                ;clear CF
        SBC HL,BC           ;HL=number of bytes actually read
        LD B,H
        LD C,L              ;save it in BC
A60780:
        LD A,10             ;A=10 (I/O PAST END error)
A60782:
        POP IX
        POP HL
        POP DE
        INC SP              ;get entry BC off stack...
        INC SP              ;without disturbing exit BC
        OR A                ;clear zero flag for return status
        RET                 ;EXIT
;***************************************************************************
;UNUSED ERROR HANDLER.
;    This routine returns error code 21, but it is not called anywhere in
;    EOS-5.  What the error signifies is unknown, though presumably it has
;    something to do with file I/O.

A60790:
        POP IX
        POP HL
        POP DE
        POP BC
        LD A,21             ;A=21 (unknown error code)
        OR A                ;clear ZF for error exit
        RET                 ;EXIT
;***************************************************************************
A60799:
        LD A,9              ;A=9 (BAD FILE NUMBER error)
A60801:
        LD HL,(BYTES_REQ)   ;HL=bytes requested to read
        LD BC,(BYTES_TO_GO) ;BC=bytes left to read
        OR A                ;clear CF
        SBC HL,BC           ;HL=number of bytes actually read
        LD B,H
        LD C,L              ;save it in BC
        JR A60782           ;error exit
;***************************************************************************
;EOS Function 55:  WRITE FILE.
;    On entry, A=file number, BC=number of bytes to write to the file, HL=
;    address of write buffer to send the data (not the same as file manager
;    DTA).  The file must already have been opened by Fn48 (open file). On
;    exit, if the write was successful, ZF=1 and A=0.  Otherwise, ZF=0 and
;    A=error code.

__WRITE_FILE:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IX
        LD (USER_BUF),HL    ;save write buffer address
        LD (BYTES_REQ),BC   ;save bytes requested to write
        LD (FNUM),A         ;save file number
        LD (BYTES_TO_GO),BC ;bytes left to write=bytes requested
        OR A                ;file number zero?
        JP Z,A61116         ;YES, so BAD FILE NUMBER error
        CP 3                ;file number less than 3?
        JP NC,A61116        ;NO, so BAD FILE NUMBER error
        LD B,A                ;B=file number
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD DE,35              ;length of FCB=35
A60851:
        ADD IX,DE           ;point IX to next FCB
        DJNZ A60851         ;offset until IX=addr of correct FCB
        LD B,A              ;set B back to file number
        LD DE,1024            ;length of DTA
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
A60862:
        ADD HL,DE           ;point HL to next file DTA
        DJNZ A60862         ;offset until correct file DTA is reached
        LD (BUF_START),HL   ;save it as write buffer start address
        ADD HL,DE           ;length=1024
        LD (BUF_END),HL     ;save write buffer end address
        PUSH IX             ;save FCB address...
        POP HL              ;and get it back in HL
        CALL __MODE_CHECK   ;*Fn67:  CHECK FILE I/O MODE
        JP NZ,A61118        ;check failed, so error exit ZF=0
;***************************************************************************
;COPY DATA FROM WRITE BUFFER TO DTA.
;    Data is copied 1024 bytes at a time, except when fewer are requested. At
;    the end each 1024-byte transfer, the write buffer start address (65030)
;    is adjusted upward for the next copy.

A60881:
        LD A,(IX+20)        ;check OK, so get hibyte of used length
        CP (IX+18)          ;is it less than allocated length?
        JR C,A60901         ;YES, so not last block of file
        LD A,(IX+19)        ;NO, so get lobyte of used length
        CP (IX+17)          ;is it less than allocated length?
        JR C,A60901         ;YES, so not last block of file
        SET 7,(IX+24)       ;NO, so this is the last available block;
                            ;set bit 7 of I/O mode byte to flag this
A60901:
        LD HL,(BUF_END)     ;HL=write buffer end address
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=DTA offset from FCB
        OR A                ;clear CF
        SBC HL,DE           ;HL=room left in DTA
        LD B,H
        LD C,L              ;save it in BC
        LD DE,(BYTES_TO_GO) ;DE=bytes left to write
        OR A                ;clear CF
        SBC HL,DE           ;are there more bytes left to write from
                            ;the write buffer than there is room in
                            ;the DTA?
        JP NC,A61075        ;NO, so write the last block and exit OK
        LD A,B              ;YES, so more than 1 block left to write
        OR C                ;is BC=0? (no more room in DTA)
        JR Z,A60956         ;YES, so write the block, reset and cont.
        LD HL,(BYTES_TO_GO) ;NO, still room, so HL=bytes left to write
        OR A                ;clear CF
        SBC HL,BC           ;compute new bytes left to write...
        LD (BYTES_TO_GO),HL ;and save it
        LD E,(IX+33)
        LD D,(IX+34)        ;get DTA offset address from FCB
        LD HL,(USER_BUF)    ;HL=address of write buffer
        LDIR                ;move last bytes from write buffer to DTA
        LD (USER_BUF),HL    ;reset HL to write buffer offset
        SET 6,(IX+24)       ;set bit 6 of I/O mode byte
                            ;(data waiting to write)
A60956:
        BIT 7,(IX+24)       ;is bit 7 of I/O mode byte set?
                            ;(last physical block of file in DTA)
        JR Z,A60971         ;NO, so write the block and continue
        POP IX              ;YES, the file is too short, so error exit
        POP HL
        POP DE
        POP BC
        LD A,10             ;A=10 (I/O PAST END error)
        OR A                ;clear ZF for error exit
        RET
;***************************************************************************
;WRITE BLOCK TO FILE AND POINT TO NEXT BLOCK.

A60971:
        INC (IX+19)         ;increment used length lobyte; any carry?
        JR NZ,A60979        ;NO, so continue
        INC (IX+20)         ;YES, so add carry to used length hibyte
A60979:
        LD A,(IX+23)        ;A=device number
        LD HL,(BUF_START)   ;HL=buffer start address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JP NZ,A61118        ;write failed, so error exit ZF=0
        RES 6,(IX+24)       ;write OK, so clear bit 6 of I/O mode byte
                            ;(no data waiting to write)
        LD HL,(BUF_START)   ;HL=buffer start address
        LD (IX+33),L
        LD (IX+34),H        ;store buffer start address in FCB
        LD (IX+21),0
        LD (IX+22),0        ;zero out last byte counter
        INC (IX+25)         ;increment loword/lobyte of next block
        JR NZ,A61042        ;no carry, so continue
        INC (IX+26)         ;carry, so add it to loword/hibyte
        JR NZ,A61042        ;no carry, so continue
        INC (IX+27)         ;carry, so add it to hiword/lobyte
        JR NZ,A61042        ;no carry, so continue
        INC (IX+28)         ;carry, so add it to hiword/hibyte
A61042:
        LD A,(IX+24)        ;A=I/O mode byte from FCB
        AND 7               ;mask out upper 5 bits
        CP 3                ;is it 3? (open for read+write)
        JP NZ,A60881        ;NO, so COPY DATA FROM WRITE BUFFER TO DTA
;***************************************************************************
;APPEND DATA TO FILE.

        LD A,(IX+23)        ;YES, so read next block of file
                            ;and append data to it; A=dev #
        LD HL,(BUF_START)   ;HL=write buffer start address
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JR NZ,A61118        ;read failed, so error exit ZF=0
A61075:
        LD BC,(BYTES_TO_GO) ;BC=bytes left to write
        LD L,(IX+21)
        LD H,(IX+22)        ;HL=last byte count for current block
        ADD HL,BC           ;HL=bytes left+block last byte count
        LD (IX+21),L
        LD (IX+22),H        ;save new last byte count
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=target transfer address from FCB
        LD HL,(USER_BUF)    ;HL=address of user buffer
        LDIR                ;copy bytes left from write buffer to DTA
        LD (IX+33),E
        LD (IX+34),D        ;set FCB data to end-of-transfer address
        SET 6,(IX+24)       ;set bit 6 of I/O mode byte
                            ;(data waiting to write)
        XOR A               ;A=0, ZF=1 for OK exit
        JR A61119           ;skip over error handler
;***************************************************************************
A61116:
        LD A,9              ;A=9 (BAD FILE NUMBER error)
A61118:
        OR A                ;clear ZF for error exit
A61119:
        POP IX
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 56:  SET CURRENT DATE.
;    On entry, B=current day, C=current month, D=current year.

__SET_DATE:
        PUSH AF
        LD A,B
        LD (EOS_DAY),A      ;set current day
        LD A,C
        LD (EOS_MONTH),A    ;set current month
        LD A,D
        LD (EOS_YEAR),A     ;set current year
        POP AF
        RET
;***************************************************************************
;EOS Function 57:  GET CURRENT DATE.
;    On exit, B=current day, C=current month, D=current year. If no date has
;    been set (0/0/0), ZF=0 and A=4 (NO DATE SET error).  Otherwise, ZF=1 and
;    A=0.

__GET_DATE:
        LD A,(EOS_DAY)      ;get current day
        LD B,A              ;into B
        LD A,(EOS_MONTH)    ;get current month
        LD C,A              ;into C
        LD A,(EOS_YEAR)     ;get current year
        LD D,A              ;into D
        OR B
        OR C                ;was there a date set?
        JR Z,A61158         ;NO (all 3 zero)
        XOR A               ;YES, so A=0, ZF=1 for OK exit
        RET
;***************************************************************************
A61158:
        LD A,4              ;A=4 (NO DATE SET error)
        OR A                ;ZF=0 for error exit
        RET
;***************************************************************************
;EOS Function 46:  INITIALIZE FILE MANAGER.
;    On entry, DE=address of DTA0, HL=address of FCB0.  On exit, the I/O mode
;    byte (24) of FCB0, FCB1 and FCB2 is set to zero.

__FMGR_INIT:
        LD (FCB_DATA_ADDR),DE ;address of DTA0=DE
        LD (FCB_HEAD_ADDR),HL ;address of FCB0=HL
        PUSH BC
        PUSH DE
        PUSH IX
        LD B,3                ;loop 3 times
        LD DE,35              ;length of FCB=35
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
A61182:
        LD (IX+24),0        ;zero out I/O mode byte
        ADD IX,DE           ;point IX to next FCB
        DJNZ A61182         ;loop back 3 times
        POP IX
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 68:  READ DIRECTORY FOR FILE.
;    On entry, A=device number, HL=address of filename string.  On exit, if
;    file was found, ZF=1, A=0, BCDE=start block of file, and FCB0 bytes 33-34
;    contain the address of the matching entry in DTA0.  Otherwise, ZF=0 and
;    A=error code.

__SCAN_FOR_FILE:
        PUSH HL
        PUSH IX
        PUSH IY
        LD (USER_NAME),HL     ;save address of file name string
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD (IX+23),A          ;set device #
        LD (IX+25),1          ;block to read=1 (directory)
        LD (IX+26),0
        LD (IX+27),0
        LD (IX+28),0
        LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0
        LD (IX+33),E
        LD (IX+34),D          ;save it in FCB0 (current DTA offset addr)
        LD HL,FILE_COUNT      ;HL=address of file count
        LD (HL),0             ;zero out count
        LD A,(IX+23)          ;A=device #
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A61478        ;read failed, so error exit ZF=0
        PUSH HL             ;save DTA offset address...
        POP IY              ;and get it back in IY
                            ;we should be pointing at VOLUME entry
        LD A,(IY+12)        ;A=volume size byte
        AND 127             ;mask out bit 8
        LD (IX+29),A        ;save volume size loword/lobyte in FCB0
        LD (IX+30),0        ;zero out loword/hibyte
        LD (IX+31),0        ;zero out hiword/lobyte
        LD (IX+32),0        ;zero out hiword/hibyte
        CALL A61493         ;VERIFY DIRECTORY CHECK CODE subroutine
        JP NZ,A61478        ;bad code, so error exit ZF=0
        LD A,(IX+33)        ;code OK, so get lobyte of current DTA
                            ;offset address
        ADD A,26            ;point ahead to next dir entry (DIRECTORY)
        LD (IX+33),A        ;save new lobyte in FCB0
        LD A,(IX+34)        ;get hibyte
        ADC A,0             ;propagate any carry from lobyte add
        LD (IX+34),A        ;save new hibyte in FCB0
        LD HL,FILE_COUNT    ;HL=address of file count
        INC (HL)            ;we've looked at first entry
        LD B,38             ;38 more to look at
        JR A61393           ;keep looking
;***************************************************************************
;READ DIRECTORIES WITH MORE THAN 1 BLOCK.
;    On entry, bytes 32-29 of FCB0 contain the maximum directory size.  Since
;    the directory also begins at block 1, this is also the last directory
;    block number.

A61318:
        INC (IX+25)         ;point to next directory block to read
                            ;NOTE: any carry is not propagated through
                            ;other 3 bytes, thus 255+1=0
                            ;thus physical max dirsize=255 blocks
        LD A,(IX+32)        ;get max block hiword/hibyte
        CP (IX+28)          ;is it less than next block?
        JP C,A61484         ;YES, so error 5 exit
        LD A,(IX+31)        ;NO, so get max block hiword/lobyte
        CP (IX+27)          ;is it less than next block?
        JP C,A61484         ;YES, so error 5 exit
        LD A,(IX+30)        ;NO, so get max block loword/hibyte
        CP (IX+26)          ;is it less than next block?
        JP C,A61484         ;YES, so error 5 exit
        LD A,(IX+29)        ;NO, so get max block loword/lobyte
        CP (IX+25)          ;is it less than next block?
        JP C,A61484         ;YES, so error 5 exit
        LD A,(IX+23)          ;NO, next block OK, get device # from FCB0
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=next block to read
        CALL __READ_BLOCK   ;*Fn65:  READ BLOCK
        JP NZ,A61478          ;read failed, so error exit ZF=0
        LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0
        LD (IX+33),E
        LD (IX+34),D        ;save it in FCB0
        LD B,39             ;39 files to read
;***************************************************************************
A61393:
        LD HL,FILE_COUNT    ;HL=address of file count
        INC (HL)            ;count to next file
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=DTA offset addr (current entry start)
        LD L,12
        LD H,0              ;HL=12
        ADD HL,DE           ;offset to attribute byte
        BIT 0,(HL)          ;is bit 0 set? (NOT A FILE)
        JR NZ,A61484        ;YES, so BLOCKS LEFT and end of directory
                             ;error exit ZF=0
        BIT 2,(HL)          ;is bit 2 set? (DELETED FILE)
        JR NZ,A61435        ;YES, file is deleted, so skip over it
        LD HL,(USER_NAME)   ;NO, it's a real file, so get address of
                             ;file name string
        LD A,(FILENAME_CMPS) ;A=file name comparison byte
        OR A                 ;is it zero?
        JR Z,A61430         ;YES, so COMPARE FILE NAMES WITH TYPE sub
        CALL A61524         ;NO, so COMPARE FILE NAMES WITHOUT TYPE
        JR A61433           ;skip COMPARE WITH TYPE subrt and continue
;***************************************************************************
A61430:
        CALL A61523         ;COMPARE FILE NAMES WITH TYPE subroutine
A61433:
        JR Z,A61456         ;names match! so get start block and exit
A61435:
        LD A,(IX+33)        ;no match, look again; A=DTA offset lobyte
        ADD A,26            ;point to next directory entry
        LD (IX+33),A        ;save new lobyte in FCB0
        LD A,(IX+34)        ;get hibyte
        ADC A,0             ;propagate any carry from lobyte add
        LD (IX+34),A        ;save new hibyte
        DJNZ A61393         ;keep looking 'til all 38 are looked at
        JP A61318           ;we reached the end of the directory
                            ;block without finding BLOCKS LEFT, so
                            ;directory must have multiple blocks.
                            ;get next directory block and keep looking
;***************************************************************************
A61456:
        PUSH DE             ;match! save addr of file entry in DTA...
        POP IY              ;and get it back in IY
        LD E,(IY+13)
        LD D,(IY+14)
        LD C,(IY+15)
        LD B,(IY+16)        ;BCDE=starting block from directory entry
        POP IY
        POP IX
        POP HL
        XOR A               ;A=0, ZF=1
        RET                 ;exit OK
;***************************************************************************
A61478:
        POP IY
        POP IX
        POP HL
        RET                 ;error exit with ZF=0, A=error code
;***************************************************************************
A61484:
        POP IY
        POP IX
        POP HL
        LD A,5              ;A=5 (NO MORE DIRECTORY error)
                             ;this could also be called FILE NOT FOUND
        OR A                ;clear ZF
        RET
;***************************************************************************
;VERIFY DIRECTORY CHECK CODE subroutine.
;    On entry, IY=base of DTA0, which contains the first directory block.  On
;    exit, if check code is 55AA00FF, ZF=1 and A=0.  Otherwise, ZF=1 and A=24
;    (NON-EOS VOLUME error).

A61493:
        PUSH IY
        PUSH BC
        PUSH HL
        LD HL,A62439        ;HL=addr of 4-byte code in volume entry
                            ;in disk initialization data table
        LD B,4              ;B=number of bytes to compare
A61502:
        LD A,(HL)           ;get a byte from the data table
        CP (IY+13)          ;does it match what's in DTA0?
        JR NZ,A61519        ;NO, so error 24 exit
        INC HL              ;YES, so point to next byte in data table
        INC IY              ;point to next byte in DTA0
        DJNZ A61502         ;keep comparing 'til all 4 bytes checked
        XOR A               ;they match! OK exit A=0, ZF=1
A61514:
        POP HL
        POP BC
        POP IY
        RET
;***************************************************************************
A61519:
        LD A,24             ;no match! A=24 (NON-EOS VOLUME), ZF=0
        JR A61514           ;error exit
;***************************************************************************
;FILENAME COMPARISON subroutines.
;    On entry, HL=filename address, DE=address of directory entry in DTA0.  On
;    exit, if the names match, ZF=1 and A=0.  Otherwise, ZF=0 and A=8 (MATCH
;    NOT FOUND error).  Unfortunately, this routine has 2 entry points with
;    overlapping reading frames.

;    (1) Return error if any mismatched characters, including filetype.  Fn52
;        (find file, with type) results in a call to this routine.  Enters at
;        61523:

;61523 E637     AND 55      ;clears CF; continue at 61525

;    (2) Allows the filetype byte to mismatch; otherwise returns error.  Fn69
;        (find file, no type) results in a call to this routine.  Enters at
;        61524:

;61523 E6                   ;unused
;61524 37       SCF         ;sets CF; continues at 61525

A61523:
        DB 230
A61524:
        SCF
        PUSH HL
        PUSH DE
        PUSH BC
        PUSH AF             ;save status of CF
        LD B,12             ;B=number of bytes to compare
A61531:
        LD A,(HL)           ;get character from string
        CP 3                ;is it the end? (hex 03=logical end)
        JR Z,A61559         ;YES, so see if the dir entry also ends
        LD A,(DE)           ;NO, so get character from dir entry
        CP (HL)             ;does it match the string?
        JR NZ,A61547        ;NO, but that may not be fatal...
        INC HL              ;YES, so point to next character in string
        INC DE              ;point to next character in dir entry
        DJNZ A61531         ;keep going 'til all are compared
        POP BC              ;all 12 match, so exit OK
        JR A61565
;***************************************************************************
A61547:
        POP AF              ;restore status of CF
        JR NC,A61570        ;CF clear (strict match), so exit error 8
        INC HL              ;CF set (type can mismatch), so point to
                            ;next character in string
        INC DE              ;point to next character in dir entry
        LD A,(HL)           ;get character from string
        CP 3                ;is it the end?
        JR NZ,A61570        ;NO, so exit error 8
        JR A61560           ;YES, skip to see if dir entry also ends
;***************************************************************************
A61559:
        POP BC
A61560:
        LD A,(DE)           ;get character from directory entry
        CP 3                ;is it the end?
        JR NZ,A61570        ;NO, so exit error 8
A61565:
        POP BC              ;YES, so exit OK
        POP DE
        POP HL
        XOR A               ;A=0, ZF=1
        RET                 ;exit OK
;***************************************************************************
A61570:
        POP BC
        POP DE
        POP HL
        LD A,8              ;A=8 (MATCH NOT FOUND error)
        OR A                ;clear ZF
        RET                 ;exit error
;***************************************************************************
;EOS Function 64:  CHECK IF FILE IS OPEN.
;    On entry, HL=address of file name string.  On exit, if the file is open,
;    ZF=1, A=0 and B=lower 3 bits of the I/O mode byte from the FCB (read,
;    write, execute).  Otherwise, ZF=0 and A=5 (FILE NOT OPEN error).

__CHECK_FCB:
        PUSH IX
        PUSH DE
        PUSH HL               ;save filename string address
        LD HL,(FCB_HEAD_ADDR) ;HL=address of FCB0
        XOR A                 ;A=0
A61585:
        INC A               ;increment file number counter
        LD (FILE_NUMBR),A   ;save new file number
        LD DE,35            ;length of FCB=35
        ADD HL,DE           ;point to next FCB
        PUSH HL             ;save address...
        POP IX              ;and get it back in IX
        LD A,(IX+24)        ;A=I/O mode byte
        AND 7               ;mask out upper 5 bits
        CP 0                ;is it zero?
        JR Z,A61623         ;YES, it's empty, so skip to next FCB
        EX DE,HL            ;NO, so DE=address of FCB
        POP HL              ;restore HL=filename string address
        PUSH HL             ;save filename string address
        PUSH DE             ;save FCB address
        LD BC,12            ;length of filename
A61612:
        LD A,(DE)           ;get character from FCB
        CP 3                ;is is hex 03? (end)
        JR Z,A61636         ;YES, but does string also end?
        CPI                 ;NO, so does it match the string at HL?
        INC DE              ;point to next character in FCB
        JR Z,A61612         ;YES, so keep comparing
        POP HL              ;NO, mismatch, so look at next FCB
                            ;HL=FCB address (saved as DE)
A61623:
        LD A,(FILE_NUMBR)   ;A=file number
        CP 2                ;is it 2?
        JR NZ,A61585        ;NO, so look at next FCB
A61630:
        POP HL              ;YES, so no more FCBs (get HL off stack)
        LD A,5              ;A=5 (FILE NOT OPEN error)
        OR A                ;clear ZF for error exit
        JR A61653
;***************************************************************************
A61636:
        LD A,(HL)           ;get character from filename string
        CP 3                ;is it hex 03? (end)
        POP HL              ;HL=FCB address (saved as DE)
        JR NZ,A61630        ;NO, so mismatch error exit
        LD A,(IX+24)        ;YES, so A=I/O mode byte from FCB
        AND 7               ;mask out upper 5 bits
        LD B,A              ;save it in B
        XOR A               ;A=0, ZF=1 for OK exit
        LD A,(FILE_NUMBR)   ;A=file number
        POP DE
A61653:
        POP DE
        POP IX
        RET
;***************************************************************************
;EOS Function 67:  CHECK FILE I/O MODE.
;    On entry, IX=address of FCB, HL=address of directory entry.  On exit,
;    IX and HL have their entry values.  This routine determines if the
;    attribute of the file will permit the I/O type requested.  If the mode
;    check was OK, ZF=1 and A=0.  Otherwise, ZF=0 and A=error code (17=BAD
;    I/O MODE, 20=FILE ACCESS DENIED).

__MODE_CHECK:
        PUSH IY
        PUSH HL             ;save dir entry address
        LD A,(IX+24)        ;A=I/O mode byte
        AND 7               ;mask out upper 5 bits
        CP 0                ;is it zero?
        JR Z,A61700         ;YES, so exit error 17 (BAD I/O MODE)
        CP 5                ;NO, but is less than 5?
        JR NC,A61700        ;NO, so exit error 17 (BAD I/O MODE)
        LD HL,A61707-1      ;YES (4,3,2,1) so point HL at mask table
        ADD A,L             ;offset into table
        LD L,A              ;HL=A61706+A
        JR NC,A61681        ;no carry from add, so skip ahead
        INC H               ;carry, so add it to hibyte (not as stupid
                            ;as it might seem, since you don't know
                            ;the real address as you write the code,
                            ;only after you assemble it
A61681:
        POP IY              ;IY=dir entry address (saved as HL)
        PUSH IY             ;save it again
        LD A,(IY+12)        ;A=file attribute from dir entry
        AND (HL)            ;mask out all but appropriate bit (if set)
        JR NZ,A61696        ;bit set, so error 20 (FILE ACCESS DENIED)
        POP HL              ;bit was clear; get back HL=dir entry addr
        POP IY
        XOR A               ;A=0, ZF=1 for OK exit
        RET
;***************************************************************************
A61696:
        LD A,20             ;A=20 (FILE ACCESS DENIED error)
        JR A61702
A61700:
        LD A,17             ;A=17 (BAD I/O MODE error)
A61702:
        POP HL
        POP IY
        OR A                ;ZF=0 for error exit
        RET
;***************************************************************************
;TABLE OF FILE ATTRIBUTE BIT MASKS.

A61707:
        DB 20H     ;0010 0000      ;read protected
        DB 40H     ;0100 0000      ;write protected
        DB 80H     ;1000 0000      ;delete protected
        DB 02H     ;0000 0010      ;execute protected
;***************************************************************************
;EOS Function 58:  RENAME FILE.
;    On entry, A=device number, DE=address of old filename string, HL=address
;    of new filename string.  On exit, if the rename was successful, ZF=1 and
;    A=0.  Otherwise, ZF=0 and A=error code.

__RENAME_FILE:
        PUSH BC
        PUSH AF
        PUSH DE
        PUSH HL
        EX DE,HL            ;swap new filename address into DE
        LD HL,QUERY_BUFFER  ;HL=query buffer address
        CALL __QUERY_FILE   ;*Fn52:  FIND FILE (WITH TYPE)
        JR Z,A61768         ;found! we can't use this name, so exit
        POP HL              ;not found, so we'll use it
        POP DE              ;DE restored as old filename address
        POP AF
        PUSH AF
        PUSH DE
        PUSH HL
        LD HL,QUERY_BUFFER  ;HL=query buffer address
        CALL __QUERY_FILE   ;*Fn52:  FIND FILE (WITH TYPE)
        JR NZ,A61768        ;old file not found, so error exit
        LD DE,QUERY_BUFFER  ;found, so DE=query buffer address
        POP HL              ;HL=address of new filename string
        PUSH HL
        LD BC,12            ;length of name=12
        LDIR                ;copy new name to old entry in query buffr
        POP HL
        POP DE
        POP AF
        PUSH AF
        PUSH DE
        PUSH HL
        LD HL,QUERY_BUFFER  ;HL=query buffer address
        CALL __SET_FILE     ;*Fn53:  UPDATE DIRECTORY ENTRY
        JR NZ,A61768        ;update failed, so error exit ZF=0
        XOR A               ;update OK, so A=0, ZF=1 for OK exit
        POP HL
        POP DE
        POP BC
        POP BC
        RET
;***************************************************************************
A61768:
        OR A                ;clear ZF for error exit
        POP HL
        POP DE
        POP BC
        POP BC
        RET
;***************************************************************************
;EOS Function 59:  DELETE FILE.
;    On entry, A=device number, HL=address of filename string for file to
;    delete.  On exit, if the delete was successful, ZF=1 and A=0.  Otherwise,
;    ZF=0 and A=error code.

__DELETE_FILE:
        PUSH DE
        PUSH HL
        PUSH AF
        EX DE,HL            ;swap filename string into DE
        LD HL,QUERY_BUFFER  ;HL=query buffer address
        CALL __QUERY_FILE   ;*Fn52:  FIND FILE (WITH TYPE)
        JR NZ,A61815           ;file not found, so error exit ZF=0
        LD A,(QUERY_BUFFER+12) ;A=attribute byte (12) of file in buffer
        BIT 7,A                ;is bit 7 set? (locked)
        JR NZ,A61812           ;YES, so exit error 16
        OR 4                   ;NO, so set bit 3 (deleted)
        LD (QUERY_BUFFER+12),A ;set new attribute back into query buffer
        POP AF                 ;restore A=device #
        POP DE              ;restore DE=address of filename string
        PUSH DE
        PUSH AF
        CALL __SET_FILE     ;*Fn53:  UPDATE DIRECTORY ENTRY
        JR NZ,A61815        ;update failed, so error exit ZF=0
        XOR A               ;update OK, so A=0, ZF=1
        POP HL              ;get AF off stack without altering flags
        POP HL
        POP DE
        RET
;***************************************************************************
A61812:
        LD A,16             ;A=16 (FILE LOCKED error)
        OR A                ;ZF=0 for error exit
A61815:
        POP HL              ;get AF off stack without altering flags
        POP HL
        POP DE
        RET
;***************************************************************************
;EOS Function 65:  READ BLOCK.
;    On entry, A=device number, BCDE=block to read (BC=hiword, DE=loword), HL=
;    data transfer address (DTA).  On exit, if the read was successful, ZF=1.
;    If not, ZF=0 and A=22 (I/O ERROR) or other error code.  Oddly, this
;    routine reads the block, checks the device status, then rereads the
;    block.  This cannot be for data integrity, as no verify operation is per-
;    formed on the data (e.g. load same block into 2 places and compare them).
;    The extra reading time is not noticeable from disk drives, but probably
;    is significant for the tape drives.  Why the routine does this I don't
;    know.  By comparison, Fn66 (write block) writes the block once, followed
;    by a status check.
;    Note added 9508.08:  According to Chris Braymen, who has done extensive
;    investigation into the workings of ADAMnet at the 6801 level, the double
;    read is actually necessary (for technical reasons which I don't know).
;    I can say that, at ADAMcon 05, while playing with his ADAMnet RAMdisk,
;    I NOPed out the CALL for the second read, and no data was transferred.
;    Restoring the CALL, it worked.

__READ_BLOCK:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IX
        PUSH IY
        PUSH AF
        LD A,2              ;number of times to retry the read
        LD (RETRY_COUNT),A  ;save retry count
A61832:
        POP AF              ;restore A=device #
        PUSH AF             ;save it again
        CALL __RD_1_BLK     ;*Fn19:  READ 1 BLOCK
        JR Z,A61853         ;read OK (A=0), so continue, check status
        CP 155              ;read failed, but was error 155?
        JR Z,A61853         ;YES, so continue, check status
        PUSH HL             ;NO, so enter retry loop; save DTA
        LD HL,RETRY_COUNT   ;HL=address of retry count
        DEC (HL)            ;one less chance to count
        POP HL              ;restore HL=DTA
        JR Z,A61914         ;no more retry chances, so error 22 exit
        JR A61832           ;still some chances, so keep trying
;***************************************************************************
A61853:
        LD B,2              ;count for status request retries
A61855:
        POP AF              ;restore A=device #
        PUSH AF               ;save it
        CALL __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
        JR Z,A61870           ;status 0 (done OK), so ...
        CP 155              ;not zero, but is it 155? (busy but OK)
        JR Z,A61855         ;YES, so keep waiting 'til it's done
        DJNZ A61855         ;NO, so error; decrement retry count
        JR A61914           ;no more status retries, so error 22 exit
;***************************************************************************
A61870:
        POP AF              ;restore A=device #
        PUSH AF             ;save it again
        CALL A61989         ;GET NODE TYPE DATA OF DEVICE (in A) subrt
        CP 0                ;is it zero?
        JR NZ,A61914        ;NO, so error 22 exit
        LD A,2              ;YES, so retry count=2
        LD (RETRY_COUNT),A  ;save retry count
        POP AF              ;restore A=device #
        POP IY
        POP IX
        POP HL              ;restore HL=DTA
        POP DE
        POP BC              ;restore BCDE=block to read
        PUSH BC
A61893:
        PUSH AF
        CALL __RD_1_BLK     ;*Fn19:  READ 1 BLOCK
        JR Z,A61911         ;success! so exit OK
        PUSH HL             ;read failed, so enter retry loop
        LD HL,RETRY_COUNT   ;HL=address of retry count
        DEC (HL)            ;one less chance to read...
        POP HL
        JR Z,A61910         ;this was our last chance, so exit
                            ;error code in A returned by Fn19
        POP AF
        JR A61893           ;let's try it again
;***************************************************************************
A61910:
        OR A                ;clear ZF for error exit
A61911:
        POP BC              ;get AF off stack without altering flags
        POP BC
        RET
;***************************************************************************
A61914:
        POP IY
        POP IY
        POP IX
        POP HL
        POP DE
        POP BC
        LD A,22             ;A=22 (I/O ERROR)
        RET
;***************************************************************************
;EOS Function 66:  WRITE BLOCK.
;    On entry, A=device number, BCDE=block to write (BC=hiword, DE=loword),
;    HL=data transfer address (DTA).  On exit, if the write was successful,
;    ZF=1.  If not, ZF=0 and A=22 (I/O ERROR).  Unlike Fn65 (read block),
;    this routine only writes the block once.

__WRITE_BLOCK:
        PUSH BC
        PUSH IY
        PUSH AF             ;save device #
        LD A,2              ;retry count=2
        LD (RETRY_COUNT),A  ;save retry count
A61935:
        POP AF              ;restore device #
        PUSH AF             ;save it again
        CALL __WR_1_BLOCK   ;*Fn44:  WRITE 1 BLOCK
        JR Z,A61956         ;write OK (A=0), so continue, check status
        CP 155              ;write failed but was error 155?
        JR Z,A61956         ;YES, so continue, check status
        PUSH HL             ;NO, so entry retry loop
        LD HL,RETRY_COUNT   ;HL=address of retry count
        DEC (HL)            ;one less chance to write...
        POP HL
        JR Z,A61982         ;this was our last chance, so exit
        JR A61935           ;let's try it again
;***************************************************************************
A61956:
        LD B,2              ;B=retry count for status request
A61958:
        POP AF              ;restore A=device #
        PUSH AF               ;save it again
        CALL __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
        JR Z,A61973           ;status OK (A=0), so continue
        CP 155              ;status not zero, but is it 155? (busy)
        JR Z,A61958         ;YES, so keep waiting 'til it's done
        DJNZ A61958         ;NO, so decrement retry count and hope...
        JR A61982           ;no more retries left, so exit error 22
;***************************************************************************
A61973:
        POP AF              ;restore A=device #
        PUSH AF             ;save it again
        CALL A61989         ;GET NODE TYPE DATA OF DEVICE (in A) subrt
        CP 0                ;is it zero?
        JR Z,A61984         ;YES, so exit OK
A61982:
        LD A,22             ;A=22 (I/O ERROR), ZF already 0
A61984:
        POP BC
        POP IY
        POP BC
        RET
;***************************************************************************
;GET NODE TYPE DATA OF DEVICE (in A) subroutine.
;    On entry, A=device number, IY=address of DCB.  On exit, if the device
;    number is greater than 15, A returns the high nibble of the node type
;    byte from the DCB.  If the device number is 15 or less, A returns the
;    low nibble of the node type byte.  This routine handles tape 1 and tape
;    2, which share the same DCB.

A61989:
        SRL A               ;A/2
        SRL A               ;A/4
        SRL A               ;A/8
        SRL A               ;A/16 (high nibble moved to low)
        CP 0                ;is it zero?
        LD A,(IY+20)        ;A=node type byte from DCB
        JR NZ,A62008        ;NO, so make A=upper nibble of node type
        AND 15              ;YES, so make A=lower nibble of node type
        JR A62016           ;exit (how about just RET?)
;***************************************************************************
A62008:
        SRL A               ;A/2
        SRL A               ;A/4
        SRL A               ;A/8
        SRL A               ;A/16 (high nibble moved to low)
A62016:
        RET
;***************************************************************************
;EOS Function 63:  TRIM FILE.
;    On entry, A=device number, DE=address of filename to trim.  On exit, any
;    excess blocks allocated to the file (but not actually used by it) are
;    deallocated.  If the next directory entry is BLOCKS LEFT, the free blocks
;    are allocated for use by subsequent files.  Otherwise, the space is
;    wasted.

__TRIM_FILE:
        PUSH HL
        PUSH IX
        PUSH IY
        PUSH DE
        PUSH AF
        LD HL,FCB_BUFFER    ;HL=base of FCB buffer
        CALL __QUERY_FILE   ;*Fn52:  FIND FILE (WITH TYPE)
        JP NZ,A62234        ;file not found, so error exit
        LD IX,FCB_BUFFER    ;IX=base of FCB buffer
        LD E,(IX+19)
        LD D,(IX+20)        ;DE=number of blocks actually used
        LD L,(IX+17)
        LD H,(IX+18)        ;HL=allocated length of file in blocks
        OR A                ;clear CF
        SBC HL,DE           ;HL=HL-DE
        LD A,H
        OR L                  ;did HL=DE?
        JP Z,A62225           ;YES, so no trim needed -- exit OK
        LD (NEW_HOLE_SIZE),HL ;NO, so new hole size in blocks=HL
        LD (IX+17),E
        LD (IX+18),D        ;make allocated length=actual used length
        LD A,(FILE_COUNT)   ;A=file count (# of files in directory)
        LD B,39             ;B=maximum number of files
A62071:
        SUB B               ;have we reached the maximum?
        JR Z,A62110         ;YES, we're at the last file in directory
        JR NC,A62071          ;NO, not yet, so keep subtracting
        LD IX,(FCB_HEAD_ADDR) ;we're past the end; IX=address of FCB0
        LD E,(IX+33)
        LD D,(IX+34)        ;DE=address of dir entry in DTA0
        PUSH DE             ;save it
        LD BC,26            ;26 bytes to move
        PUSH BC             ;save byte count
        LD HL,FCB_BUFFER    ;HL=base of FCB buffer
        LDIR                ;move dir entry from FCB buffer to DTA0
        POP DE              ;DE=26 (saved as BC)
        POP HL              ;HL=old DE=byte offset into DTA0
        ADD HL,DE           ;point to next directory entry
        PUSH HL             ;save this address...
        POP IY              ;and get it back in IY
        BIT 0,(IY+12)       ;is bit 0 of file attribute byte set?
                            ;(not a file)
        JR Z,A62202         ;NO, it's a regular file, so we can't
                            ;add any free blocks to BLOCKS LEFT
        JR A62170           ;YES, so we're at BLOCKS LEFT
                            ;add in the freed-up blocks
;***************************************************************************
A62110:
        LD A,(FILE_COUNT)     ;A=file count
        LD (MOD_FILE_COUNT),A ;mod file count=file count
        POP AF                ;restore A=device #
        POP DE              ;restore DE=address of filename to trim
        PUSH DE             ;save device # again
        PUSH AF             ;save filename address again
        LD HL,FCB_BUFFER    ;HL=base of FCB buffer
        CALL __SET_FILE     ;*Fn53:  UPDATE DIRECTORY ENTRY
        JR NZ,A62234        ;update failed, so error exit ZF=0
        POP AF              ;update OK, so restore device #
        POP DE              ;clear stack
        LD DE,A62504        ;DE=address of BLOCKS LEFT in data table
        PUSH DE             ;save it
        PUSH AF             ;save device #
        LD HL,FCB_BUFFER    ;HL=base of FCB buffer
        CALL __QUERY_FILE     ;*Fn52:  FIND FILE (WITH TYPE)
        LD IX,(FCB_HEAD_ADDR) ;IX=address of FCB0
        LD L,(IX+33)
        LD H,(IX+34)        ;HL=address of dir entry in DTA0
        PUSH HL             ;save it on stack...
        POP IY              ;and get it back in IY
        BIT 0,(IY+12)       ;is bit 0 of attrib byte set? (not a file)
        JR Z,A62234           ;NO, it's a regular file, so error exit
        LD HL,FILE_COUNT      ;YES (BLOCKS LEFT), so HL=file count addr
        LD A,(MOD_FILE_COUNT) ;A=mod file count
        INC A                 ;one more file counted
        CP (HL)             ;compare file count and mod file count+1
        JR NZ,A62225        ;NOT EQUAL, so exit OK
A62170:
        LD L,(IY+17)          ;EQUAL, so...
        LD H,(IY+18)          ;HL=allocated length in blocks
        LD DE,(NEW_HOLE_SIZE) ;DE=new hole size in blocks
        ADD HL,DE             ;add this length to the new hole size
        LD (IY+17),L
        LD (IY+18),H        ;put this new size as the allocated length
        LD L,(IY+13)
        LD H,(IY+14)        ;HL=start block loword
        OR A                ;clear CF
        SBC HL,DE           ;deduct the hole size from the start block
        LD (IY+13),L
        LD (IY+14),H        ;save new start block loword
A62202:
        LD A,(IX+23)          ;A=device #
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD E,(IX+25)
        LD D,(IX+26)
        LD C,(IX+27)
        LD B,(IX+28)        ;BCDE=block number to write
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        JR NZ,A62234        ;write failed, so error exit ZF=0
A62225:
        POP DE              ;write OK
        POP DE
        POP IY
        POP IX
        POP HL
        XOR A               ;A=0, AF=1 for OK exit
        RET
;***************************************************************************
A62234:
        OR A                ;clear ZF for error exit
        POP DE
        POP DE
        POP IY
        POP IX
        POP HL
        RET
;***************************************************************************
;EOS Function 47:  INITIALIZE DIRECTORY.
;    On entry, A=device number, C=number of directory blocks to initialize,
;    DE=length of volume in blocks, HL=address of new volume name string.  If
;    the name is longer than 12 characters, it is truncated.  On exit, if the
;    initialization was successful, ZF=1 and A=0.  Otherwise, ZF=0 and A=error
;    code.

__INIT_TAPE_DIR:
        PUSH IY
        PUSH BC
        PUSH DE
        PUSH HL
        LD (DEVICE_ID),A       ;save device #
        LD A,C                 ;A=number of dir blocks to init
        LD (SECTORS_TO_INIT),A ;save it in RAM
        PUSH HL                ;save address of new volume name string
        CALL A62383            ;SCRAMBLE DTA0 subroutine
        LD HL,A62426           ;base of data table for directory init
        LD DE,(FCB_DATA_ADDR)  ;DE=address of DTA0
        LD BC,104              ;length of init table
        LDIR                   ;move init table to DTA0
        POP HL                 ;restore address of new volume name string
        LD DE,(FCB_DATA_ADDR)  ;DE=base of DTA0
        LD B,12                ;max length of name
A62278:
        LD A,(HL)           ;get character from new volume name string
        CP 3                ;is it hex 03? (end)
        JR Z,A62291         ;YES, so copy it to DTA0 and continue
        LD (DE),A           ;NO, but copy name character to DTA0 and..
        INC HL              ;point to next character in string
        INC DE              ;point to next slot in DTA0
        DJNZ A62278         ;keep going 'til end or 12 copied
        LD A,3              ;no end reached, so we'll truncate name
        DEC DE              ;back up to byte 11 in DTA0
A62291:
        LD (DE),A              ;put in hex 03 (end)
        LD IY,(FCB_DATA_ADDR)  ;IY=base of DTA0
        LD A,(SECTORS_TO_INIT) ;A=number of blocks to initialize
        OR 128                 ;set bit 7
        LD (IY+12),A           ;copy it to volume entry (MAX DIR LENGTH)
        POP HL
        POP DE              ;restore new length of volume
        POP BC              ;restore C=max directory length
        PUSH BC
        PUSH DE
        PUSH HL
        LD (IY+17),E
        LD (IY+18),D        ;set new length of volume
        PUSH DE             ;save it
        LD DE,78            ;length of VOLUME, BOOT, DIRECTORY entries
        ADD IY,DE           ;point to BLOCKS LEFT entry
        POP DE              ;restore new length of volume
        LD (IY-9),C         ;DIRECTORY entry--allocated length=C
        LD (IY-7),C         ;DIRECTORY entry--actual length=C
        INC C               ;increment C
        LD (IY+13),C        ;BLOCKS LEFT entry--start block=after DIR
        LD B,0              ;BC=C
        EX DE,HL            ;swap length of volume into HL
        OR A                ;clear CF
        SBC HL,BC           ;number of free blocks=total-dir
        LD (IY+17),L
        LD (IY+18),H        ;allocate free blocks to BLOCKS LEFT
        LD A,1              ;A=1
        LD (SECTOR_NO),A    ;block to initialize=A
        CALL A62405         ;WRITE INITIALIZED DIRECTORY BLOCK subrt
        JR NZ,A62377           ;write failed, so error exit ZF=0
        LD A,(SECTORS_TO_INIT) ;write OK, so get # of blocks to init
        LD B,A                 ;put it in B
        DEC B               ;one less block...are we done?
        JR Z,A62376         ;YES, no more blocks, so exit OK ZF=1
        CALL A62383         ;NO, more to go, so SCRAMBLE DTA0 subrt
A62365:
        LD HL,SECTOR_NO     ;HL=address of block to initialize
        INC (HL)            ;point to next block
        CALL A62405         ;WRITE INITIALIZED DIRECTORY BLOCK subrt
        JR NZ,A62377        ;write failed, so error exit ZF=0
        DJNZ A62365         ;write OK, so keep initializing 'til done
A62376:
        XOR A               ;all blocks initialized, exit OK A=0, ZF=1
A62377:
        POP HL
        POP DE
        POP BC
        POP IY
        RET
;***************************************************************************
;SCRAMBLE DTA0 subroutine.
;    On entry, DTA0 may or may not contain a directory block previously read
;    in from a device.  Every byte but the last is moved up 1, and the first
;    is zeroed out.  This makes the block unintelligible as a directory entry,
;    if that is what it contained on entry.  A better (though slower) approach
;    would have been to zero out the whole DTA.

A62383:
        PUSH BC
        PUSH DE
        PUSH HL
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD DE,(FCB_DATA_ADDR) ;DE=address of DTA0
        INC DE                ;point up 1
        LD BC,1023          ;bytes to move
        LD (HL),0           ;zero out old 1st byte
        LDIR                ;move 1023 bytes from (HL) up 1
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;WRITE INITIALIZED DIRECTORY BLOCK subroutine.
;    On entry, DTA0 contains a block of data destined for a directory.  This
;    data is written to the appropriate block of the directory.  If write was
;    successful, ZF=1 and A=0.  Otherwise, ZF=0 and A=error code.

A62405:
        PUSH BC
        LD HL,(FCB_DATA_ADDR) ;HL=address of DTA0
        LD A,(SECTOR_NO)      ;A=block to initialize
        LD E,A              ;save it as loword/lobyte
        LD D,0              ;zero out BCD
        LD BC,0             ;BCDE=block number to write
        LD A,(DEVICE_ID)    ;A=device number
        CALL __WRITE_BLOCK  ;*Fn66:  WRITE BLOCK
        POP BC
        RET
;***************************************************************************
;DIRECTORY INITIALIZATION DATA.

A62426:
        DB "            "
        DB 80H                     ;
A62439:
        DB 55H,0AAH,00H,0FFH       ;EOS directory check
        DW 0,0,0
        DB 0,0,0
A62452:
        DB "BOOT",3,"       "
        DB 88H                     ;
        DW 0,0,1,1,0
        DB 0,0,0
A62478:
        DB "DIRECTORY",3,"  "
        DB 0C8H                    ;
        DW 1,0,128,1,1024
        DB 0,0,0
A62504:
        DB "BLOCKS LEFT",3
        DB 01H                     ;not a file
        DW 0,0,0,0,0
        DB 57H,07H,11H             ;EOS revision date
;***************************************************************************
;EOS Function 70:  POSITION FILE.
;    Not implemented in EOS-5.  Used in EOS-7 to move the read/write pointer
;    in a random-access file.  SmartBASIC 1.0 provides its own routine to do
;    this; SmartBASIC 2.0 requires the EOS-7 routine.

__POSIT_FILE:

;***************************************************************************
;EOS Function 71:  EOS1.
;    Not implemented in EOS-5.  In EOS-7, it is a consolidated master block
;    I/O routine, part of the space-saving rewrite to add a third 1024-byte
;    buffer.

__EOS_1:

;***************************************************************************
;EOS Function 72:  EOS2.
;    Not implemented in EOS-5.  In EOS-7, it is a block I/O subroutine.

__EOS_2:

;***************************************************************************
;EOS Function 73:  EOS3.
;    Not implemented in either EOS-5 or EOS-7.  What it was supposed to do is
;    anybody's guess.

__EOS_3:

;***************************************************************************
;EOS Function 74:  INCORRECT EOS VERSION ERROR.
;    EOS-5 leaves several of its functions unimplemented.  This might not be
;    true in some later, suped-up version of EOS.  Programs written to utilize
;    these extra functions would bomb if run under earlier, incompatible
;    versions of EOS.  Consequently, jump table entries for routines which
;    never got off the drawing board in EOS-5 point here to return an error
;    code (A=23).  This allows the incompatible program to terminate nicely
;    with an error message, rather than just locking up the system when the
;    call to a non-existent routine sends the program counter off to never-
;    never land.  Under EOS-5, Fn70 (position file), Fn71 (EOS1), Fn72 (EOS2),
;    Fn73 (EOS3) remain unimplemented, and are redirected here.  On exit, ZF=0
;    and A=23 (INCORRECT EOS VERSION error).

;    Note added 9508.08:  I believe that the label CV_A stands for
;    "ColecoVision Alpha", possibly refering to the OS7 ROM (which contains
;    a character set).  The comments in the EOS6 source say

;    RETURN ERROR CODES UNTIL THESE ROUTINES ARE WRITTEN
;
;    10/12/83   VSB
;    10/14/83   RPD   changed __EOS_4 to __CV_A

;    so I suspect that this was a debugging trap during EOS code development.


__CV_A:
        LD A,23             ;A=23 (INCORRECT EOS VERSION error)
        OR A                ;clear ZF for error
        RET
;***************************************************************************
;EOS Functions 12/13:  FIND/GET DCB ADDRESS (in IY).
;    On entry, A=device number.  On exit, if the device exists, ZF=1, A=device
;    number and IY=DCB address.  Otherwise, ZF=0 and A=1 (NON-EXISTENT DEVICE
;    error).

__FIND_DCB:
__GET_DCB_ADDR:
        PUSH BC
        PUSH DE
        LD C,A              ;save device number in C
        LD IY,(CURRENT_PCB) ;IY=address of current PCB
        LD B,(IY+3)         ;B=number of valid DCBs
        XOR A               ;A=0
        CP B                ;are there any valid DCBs?
        JR Z,A62573         ;NO, so error and EXIT
        LD DE,4             ;YES, so skip over PCB and...
        ADD IY,DE           ;point to base of first DCB (64892)
        LD DE,21            ;length of each DCB
        LD A,C              ;A=device number
        AND 15              ;zero out upper 4 bits
A62559:
        CP (IY+16)          ;is this the right one? (IY+16 has dev#)
        JR Z,A62570         ;YES, so OK exit ZF=1
        ADD IY,DE           ;NO, so point to next DCB
        DJNZ A62559         ;keep looking until all have been searched
        JR A62573           ;couldn't find the requested DCB, so EXIT
;***************************************************************************
A62570:
        LD A,C              ;restore A=device #
        JR A62576
;***************************************************************************
A62573:
        LD A,1              ;error code=1 (NON-EXISTENT DEVICE error)
        OR A                ;clear zero flag
A62576:
        POP DE
        POP BC
        RET                 ;on OK exit, IY points to base of DCB
;***************************************************************************
;EOS Function 26:  REQUEST DEVICE (in A) STATUS.
;    On entry, A=device number.  On exit, if the device exists, A=status
;    returned by ADAMnet, with ZF=1 if A=128, ZF=0 otherwise.  If the device
;    does not exist, ZF=0 and A=1 (NON-EXISTENT DEVICE error).

__REQUEST_STATUS:
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A62599        ;device doesn't exist, so error exit ZF=0
                            ;how about RET NZ?
        LD (IY+0),1         ;device exists, so make status request
                            ;write 1 to status byte tells ADAMnet to
                            ;return the status of the device
A62588:
        BIT 7,(IY+0)        ;is bit 7 of status byte set? (status
                            ;request completed; read byte for status)
        JR Z,A62588         ;NO, still working on request, try again
        LD A,(IY+0)         ;YES, so get status in A
        CP 128              ;is it 128? (OK)
A62599:
        RET
;***************************************************************************
;EOS Function 60:  READ DEVICE (in A) NODE TYPE.
;    On entry, A=device number.  On exit, if the device exists, ZF=1 and A=
;    node type byte.  If the device doesn't exist, ZF=0 and A=1 (NON-EXISTENT
;    DEVICE error).

;    The node type byte contains ADAMnet status information for each device.
;    Unfortunately, there are 2 physical devices mapped to each node, with the
;    high nibble and low nibble of the node type byte showing the status of
;    the 2 devices, respectively.  Devices which share DCBs also share node
;    type bytes, hence tape 1 and tape 2 are shared, but disk 1 and disk 2 are
;    separate.  For tape 1, disk 1 and disk 2, the low nibble contains the
;    status information; for tape 2, the high nibble.  Returned values of the
;    nibbles decode as follows:

;         0  No Error (everything is OK)
;         1  CRC Error (block corrupt; data failed cyclic redundancy check)
;         2  Missing Block (attempt to access past physical end of medium)
;         3  Missing Media (not in drive or drive door open)
;         4  Missing Drive (not connected or not turned on)
;         5  Write-Protected (write-protect tab covered)
;         6  Drive Error (controller or seek failure)

__RD_DEV_DEP_STAT:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A62611        ;device doesn't exist, so error exit ZF=0
        XOR A               ;device exists, so A=0 (set ZF=1)
        LD A,(IY+20)        ;A=device node type byte
A62611:
        POP IY
        RET
;***************************************************************************
;CHECK IF DEVICE (IN A) IS READY subroutine.
;    On entry, A=device number, IY=DCB address.  On exit, ZF=1 and A=entry
;    device number if device is ready (status=0 or bit 7 of status set).
;    Otherwise, ZF=0 and A=2 (DEVICE NOT READY error).

A62614:
        PUSH BC
        LD C,A              ;save device # in C
        LD A,(IY+0)         ;get status byte from DCB
        CP 0                ;is it zero?
        JR Z,A62629         ;YES, so exit OK
        BIT 7,(IY+0)        ;NO, but is bit 7 set?
        JR Z,A62633         ;NO, not ready, so error exit
A62629:
        XOR A               ;YES, we're ready; A=0, ZF=1
        LD A,C              ;restore device #
        JR A62636           ;exit OK
;***************************************************************************
A62633:
        INC A               ;clears ZF (not obvious, but it does)
        LD A,2              ;A=2 (DEVICE NOT READY error)
A62636:
        POP BC
        RET
;***************************************************************************
;CHECK IF DEVICE I/O IS DONE subroutine.
;    On entry, IY=DCB address.  On exit, ZF=1 and A=0 if device I/O is
;    finished (status not zero).  Otherwise, ZF=0 and A=3 (I/O NOT DONE
;    error).

A62638:
        LD A,(IY+0)         ;read DCB status byte
        OR A                ;is it zero?
        JR NZ,A62648        ;NO, so all done
        LD A,3              ;YES, A=3 (I/O NOT DONE error)
        OR A                ;clear ZF
        RET                 ;error exit
;***************************************************************************
A62648:
        XOR A               ;A=0 and ZF set
        RET                 ;exit OK
;***************************************************************************
;EOS Function 20:  READ KEYBOARD.
;    On exit, if read was successful, ZF=1 and A=character typed.  If not,
;    ZF=0 and A=error code.

__RD_KBD:
        PUSH BC
        PUSH DE
        CALL __START_RD_KBD ;*Fn40:  START READ KEYBOARD
        JR NZ,A62664        ;start failed, so error exit ZF=0
        LD C,A              ;start OK, so
A62658:
        LD A,C
        CALL __END_RD_KBD   ;*Fn9: END READ KEYBOARD
        JR NC,A62658        ;not done yet, so keep trying
A62664:
        POP DE              ;read ended, so exit OK
        POP BC
        RET
;***************************************************************************
;EOS Function 27:  REQUEST KEYBOARD STATUS.
;    On exit, A=status.  ZF=1 if A=128, otherwise ZF=0.

__REQ_KBD_STAT:
        LD A,1              ;device 1=keyboard
        JP __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
;***************************************************************************
;EOS Function 40:  START READ KEYBOARD.
;    On exit, if start was successful, ZF=1 and A=1 (device number).  Other-
;    wise, ZF=0 and A=error code (1=NON-EXISTENT DEVICE, 2=DEVICE NOT READY).

__START_RD_KBD:
        PUSH BC
        PUSH DE
        LD A,1                 ;1=keyboard
        LD DE,KEYBOARD_BUFFER  ;DE=address of keyboard buffer
        LD BC,1                ;1 character to read
        CALL __START_RD_CH_DEV ;*Fn39: START READ CHARACTER DEVICE (in A)
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 9:  END READ KEYBOARD.
;    On exit, if end was successful, ZF=1 and A=character typed.  Otherwise,
;    ZF=0 and CF reflects various error conditions.  CF=0 if not done reading,
;    CF=1 if done but I/O error (code in A).

__END_RD_KBD:
        LD A,1               ;1=keyboard
        CALL __END_RD_CH_DEV ;*Fn8: END READ CHARACTER DEVICE (in A)
        JR NC,A62715         ;not done reading, so error exit CF=0
        JR Z,A62709         ;done! so get character and exit OK
        CP 140              ;bad end, but was it 140?
        JR NZ,A62706        ;NO, so error exit CF=1, ZF=0
        CALL __START_RD_KBD ;YES, so *Fn40:  START READ KEYBOARD
        JR Z,A62714         ;start OK, so clear CF and exit
A62706:
        SCF                 ;start failed, so CF=1
        JR A62715           ;error exit ZF=0 (how about RET?)
;***************************************************************************
A62709:
        LD A,(KEYBOARD_BUFFER) ;A=last character typed (from kybd buffer)
        JR A62715              ;exit OK (how about RET?)
;***************************************************************************
A62714:
        OR A                ;adjust ZF and clear CF
A62715:
        RET
;***************************************************************************
;EOS Function 18:  PRINT CHARACTER (in A).
;    On entry, A=character to send to the line printer.  On exit, if the
;    print was successful, ZF=1 and A=0.  Otherwise, ZF=0 and A=error code.

__PR_CH:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        LD (PRINT_BUFFER),A   ;put A as 1st character in print buffer
        LD A,3                ;hex 03=logical end-of-buffer
        LD (PRINT_BUFFER+1),A ;terminate buffer
        LD HL,PRINT_BUFFER    ;HL=address of print buffer
        CALL __PR_BUFF        ;*Fn17:  PRINT BUFFER (at HL)
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 17:  PRINT BUFFER (at HL).
;    On entry, HL=address of a print buffer terminated by hex 03.  The logical
;    buffer may be of any length, but only 16 characters at a time may be
;    printed (physical length).  On exit, if printing ended successfully, ZF=1
;    and A=0.  Otherwise, ZF=0 and A=error code.

__PR_BUFF:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        LD A,2              ;2=printer
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A62808        ;device doesn't exist, so error exit ZF=0
        CALL A62614         ;device exists, so CHECK IF DEVICE (IN A)
                            ;IS READY subroutine
        JR NZ,A62808        ;device not ready, so error exit ZF=0
A62758:
        LD BC,0             ;device ready, so zero out char counter
        LD E,L
        LD D,H              ;DE=buffer start address
A62763:
        LD A,3              ;hex 03=logical end-of-buffer character
        CP (HL)             ;is it the logical end?
        JR Z,A62792         ;YES, so now let's print to logical end
        INC HL              ;NO, so point to next character
        INC C               ;count next character
        LD A,C              ;save it in A
        CP 16               ;is it 16? (physical buffer max)
        JR NZ,A62763        ;NO, so keep counting
        EX DE,HL            ;YES, so print full buffer:  HL=start
A62776:
        LD A,2              ;device 2=printer
        CALL __WR_CH_DEV    ;*Fn45:  WRITE CHARACTER DEVICE (in A)
        JR Z,A62789         ;write OK, so get next 16 characters
        CP 134              ;write failed; is it still printing? (134)
        JR NZ,A62808        ;NO, so error exit ZF=0
        JR A62776           ;YES, so keep trying 'til it's done
;***************************************************************************
A62789:
        EX DE,HL            ;HL=new buffer start=old buffer end
        JR A62758           ;print the next 16 character in the buffer
;***************************************************************************
A62792:
        EX DE,HL            ;HL=buffer start, DE=last char address
        XOR A               ;A=0
        CP C                ;have we emptied the logical buffer?
        JR Z,A62808         ;YES, so OK exit ZF=1, A=0
A62797:
        LD A,2              ;NO, still some to print, so get device #
        CALL __WR_CH_DEV    ;*Fn45:  WRITE CHARACTER DEVICE (in A)
        JR Z,A62808         ;write OK, so exit ZF=1, A=0
        CP 134              ;write failed; is it still printing? (134)
        JR Z,A62797         ;YES, so keep trying 'til it's done
A62808:
        POP IY              ;NO, so error exit ZF=0
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;THIS SECTION OF CODE DUPLICATES Fn37, BUT IS NOT USED ANYWHERE IN EOS-5.

A62814
        LD (PRINT_BUFFER),A   ;put A as 1st character in print buffer
        LD A,3                ;hex 03=logical end-of-buffer
        LD (PRINT_BUFFER+1),A ;terminate buffer
        LD HL,PRINT_BUFFER    ;HL=address of print buffer
        CALL __START_PR_BUFF  ;*Fn36:  START PRINT BUFFER (at HL)
        RET
;***************************************************************************
;EOS Function 37:  START PRINT CHARACTER (in A).
;    On entry, A=character to print.  On exit, if start was successful, ZF=1
;    and A=0.  Otherwise, ZF=0 and A=error code.

__START_PR_CH:
        LD (PRINT_BUFFER),A   ;put A as 1st character in print buffer
        LD A,3                ;hex 03=logical end-of-buffer
        LD (PRINT_BUFFER+1),A ;terminate buffer
        LD HL,PRINT_BUFFER    ;HL=address of print buffer
        CALL __START_PR_BUFF  ;*Fn36:  START PRINT BUFFER (at HL)
        RET
;***************************************************************************
;EOS Function 6:  END PRINT CHARACTER (in A).
;    On exit, if end was successful, ZF=1.  If not, ZF=0 and CF reflects
;    various error conditions.  CF=0 if not done printing, CF=1 if done but
;    I/O error (code in A).

__END_PR_CH:
        CALL __END_PR_BUFF  ;*Fn5: END PRINT BUFFER (at HL)
        RET
;***************************************************************************
;EOS Function 36:  START PRINT BUFFER (at HL).
;    On entry, HL=address of a print buffer terminated by hex 03.  The logical
;    buffer may be of any length, but only 16 characters at a time may be
;    printed (physical length).  If start was OK, ZF=1 and A=0.  Otherwise,
;    ZF=0 and A=error code.

__START_PR_BUFF:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        LD A,2              ;2=printer
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A62898        ;device doesn't exist, so error exit ZF=0
        CALL A62614         ;device exists, so CHECK IF DEVICE (IN A)
                            ;IS READY subroutine
        JR NZ,A62808        ;device not ready, so error exit ZF=0
        LD BC,0             ;device ready, so zero out char counter
        LD E,L
        LD D,H              ;DE=buffer start address
A62870:
        LD A,3              ;hex 03=logical end-of-buffer character
        CP (HL)             ;is it the logical end?
        JR Z,A62890         ;YES, so now let's print to logical end
        INC HL              ;NO, so point to next character
        INC C               ;count next character
        LD A,C              ;save it in A
        CP 16               ;is it 16? (physical end)
        JR NZ,A62870        ;NO, so keep counting
        EX DE,HL            ;YES, so print full buffer:  HL=start
        LD A,2                 ;device 2=printer
        CALL __START_WR_CH_DEV ;*Fn42:  start write character dev (in A)
        JR A62898              ;exit with ZF reflecting status of start
;***************************************************************************
A62890:
        EX DE,HL            ;HL=new buffer start=old buffer end
        XOR A               ;A=0
        CP C                ;have we emptied the logical buffer?
        LD A,2                    ;device 2=printer
        CALL NZ,__START_WR_CH_DEV ;NO, so *Fn42: start write char dev (in A)
A62898:
        POP IY              ;exit with ZF reflecting start status
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 5:  END PRINT BUFFER (at HL).
;    On exit, if end was successful, ZF=1.  If not, ZF=0 and CF reflects
;    various error conditions.  CF=0 if not done printing, CF=1 if done but
;    I/O error (code in A).

__END_PR_BUFF:
        PUSH IY
        LD A,2               ;device 2=printer
        CALL __FIND_DCB      ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        CALL __END_WR_CH_DEV ;*Fn11:  END WRITE CHARACTER DEVICE (in A)
        JR NC,A62927         ;not done writing, so error exit CF=0
        JR Z,A62927         ;done! so OK exit
        CP 134              ;bad end; was it 134?
        JR NZ,A62927        ;NO, so I/O error exit ZF=0
        LD (IY+0),3         ;YES, so request write
        OR A                ;adjust ZF, clear CF
A62927:
        POP IY
        RET
;***************************************************************************
;EOS Function 28:  REQUEST PRINTER STATUS.
;    On exit, A=status.  ZF=1 if A=128, otherwise ZF=0.

__REQ_PR_STAT:
        LD A,2              ;device number 2=printer
        JP __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
;***************************************************************************
;EOS Function 29:  REQUEST TAPE STATUS.
;    On exit, A=status.  ZF=1 if A=128, otherwise ZF=0.

__REQ_TAPE_STAT:
        LD A,8              ;device number 8=tape 1/2
        JP __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
;***************************************************************************
;EOS Function 2:  CONSOLE INITIALIZATION.
;    On entry, B=number of columns (X) for screen, C=number of lines (Y), D=
;    column of upper left corner (X-min), E=line of upper left column (Y-min),
;    HL=VRAM address of name table.  Note:  This routine is not used by
;    SmartBASIC, though its own routine is almost identical.

__CONS_INIT:
        INC B                 ;one more to see if we've gone too far
        INC C                 ;ditto
        LD (NUM_LINES),BC     ;65183=# of lines, 65184=# of columns
        LD (UPPER_LEFT),DE    ;65185=upper left line, 65186=column
        LD (CURSOR),DE        ;65189=current cursor line, 65190=column
        LD (PTRN_NAME_TBL),HL ;VRAM address of name table=HL
        LD A,D
        LD (X_MIN),A        ;X min=upper left column
        ADD A,B
        DEC A
        LD (X_MAX),A        ;X max=(X min)+number of columns-1
        LD A,E
        LD (Y_MIN),A        ;Y min=upper left line
        ADD A,C
        DEC A
        LD (Y_MAX),A        ;Y max=(Y min)+number of lines-1
        LD A,32
        LD (OLDCHAR_),A     ;old character=space
        LD A,95             ;character=underline
        CALL A63450         ;DISPLAY CHARACTER IN A ON SCREEN subrt
        RET
;***************************************************************************
;EOS Function 3:  DISPLAY CHARACTER OR CONTROL CHARACTER ON SCREEN.
;    On entry, character to display is in A.  If the character is ^\ (28),
;    D=column, E=line to quickmove the cursor to.  Note:  This routine is
;    not used by SmartBASIC, though its own routine is almost identical.
;    The control character handling routines, however, are different.

__CONS_OUT:
        PUSH AF
        PUSH BC
        PUSH HL
        PUSH IX
        PUSH IY
        PUSH DE
        LD HL,A63502        ;HL=addr of data table of control chars
        LD BC,12            ;length of table=12
        CPIR                ;compare table with character in A
        JR NZ,A63023        ;not found, so just print regular char
        LD HL,A63514        ;HL=jump table addr for control char print
        ADD HL,BC
        ADD HL,BC           ;offset into table
        LD B,A              ;temporarily store character in B
        LD A,(HL)           ;get lobyte of execute address
        INC HL              ;point to hibyte
        LD H,(HL)           ;get hibyte of execute address in H
        LD L,A              ;put lobyte in L
        JP (HL)             ;jump to execute address in HL
;***************************************************************************
;EOS Function 1:  CONSOLE DISPLAY OF NON-CONTROL CHARACTER (in A).
;    On entry, A=character to display.  Performs line wraparound and screen
;    scroll up if necessary.  Note:  This routine is not used by SmartBASIC,
;    though its own routine is almost identical.

__CONS_DISP:
        PUSH AF
        PUSH BC
        PUSH HL
        PUSH IX
        PUSH IY
        PUSH DE
A63023:
        CALL A63450         ;DISPLAY CHARACTER (IN A) ON SCREEN subrt
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        INC H               ;move cursor to next column
        LD A,(X_MAX)        ;A=X max
        CP H                ;have we gone too far right?
        JR NC,A63056        ;NO, so print cursor at next position
        LD A,(X_MIN)        ;YES:  A=X min
        LD H,A              ;put cursor back at start column
        INC L               ;go to next line
        LD A,(Y_MAX)        ;A=Y max
        CP L                ;have we gone too far down?
        JR NC,A63056        ;NO, so print cursor at next position
        DEC L               ;YES:  back up to screen bottom
        PUSH HL             ;save cursor coordinates
        CALL A63469         ;READ OLD CHARACTER AT CURRENT CURSOR X,Y
        CALL A63380         ;PRINT OLD CHARACTER AND SCROLL UP 1 LINE
        POP HL              ;get back cursor coordinates
A63056:
        LD (CURSOR),HL      ;save current cursor line and column
A63059:
        CALL A63472         ;READ OLD CHARACTER AT CURRENT CURSOR X,Y
A63062:
        LD A,95             ;cursor character=underline
        CALL A63450         ;DISPLAY CHARACTER (IN A) ON SCREEN subrt
A63067:
        POP DE
        POP IY
        POP IX
        POP HL
        POP BC
        POP AF
        RET
;***************************************************************************
;CARRIAGE RETURN ^M (13) subroutine.
;    The cursor is moved to the far left of the screen, on the same line.

A63076:
        CALL A63447         ;DISPLAY OLD CHARACTER ON SCREEN subrt
        LD A,(X_MIN)        ;A=X min
        LD (CURSOR+1),A     ;cursor column=X min
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        JP A63059           ;READ NEXT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
;UP ARROW (160) subroutine.
;    The cursor is moved up 1 line in the same column.  If the cursor was
;    already at the first line, nothing happens.

A63091:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        LD A,(Y_MIN)        ;A=Y min
        CP L                ;are we at the first line?
        JR Z,A63067         ;YES, so EXIT without doing anything
        DEC L               ;NO, so back cursor up 1 line
A63101:
        CALL A63447         ;DISPLAY OLD CHARACTER ON SCREEN subrt
        JP A63056           ;PRINT CURSOR AT NEW X,Y (H,L)
;***************************************************************************
;LINE FEED ^J (10) OR DOWN ARROW (162) subroutine.
;    The cursor is moved down 1 line in the same column.  If the cursor was
;    already at the last line, line feed scrolls up the screen; down arrow
;    does nothing.

A63107:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        LD A,(Y_MAX)        ;A=Y max
        CP L                ;are we at the last line?
        JR Z,A63120         ;YES, so scroll up 1 line if line feed
        INC L               ;NO, so move cursor down 1 line
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
A63120:
        LD A,10
        CP B                ;is it line feed?
        JR NZ,A63067        ;NO, so EXIT with no screen scroll
        CALL A63380         ;YES, so SCROLL UP 1 LINE subroutine
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        JP A63059           ;READ NEXT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
;RIGHT ARROW (161) subroutine.
;    The cursor is moved right one column on the same line.  If the cursor
;    was already at right margin, then it hops down to the next line at the
;    left margin.  If the cursor was on the last line, however, the screen is
;    not scrolled up.

A63134:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        LD A,(X_MAX)        ;A=X max
        CP H                ;are we at the last column?
        JR Z,A63147         ;YES, so hop to next line at far left
        INC H               ;NO, so move cursor right 1 column
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
A63147:
        LD A,(Y_MAX)        ;A=Y max
        CP L                ;are we at the last line?
        JR Z,A63067         ;YES, so EXIT (can't scroll up)
        INC L               ;NO, so move cursor down 1 line
        LD A,(X_MIN)        ;A=X min
        LD H,A              ;cursor column=X min
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
;LEFT ARROW (163) OR BACKSPACE ^H (8) subroutine.
;    The cursor is moved left one column on the same line.  If the cursor was
;    already at the left margin, it hops up to the previous line at the right
;    margin.  If the cursor was on the first line, however, the screen is not
;    scrolled down.

A63161:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        LD A,(X_MIN)        ;A=X min
        CP H                ;are we at the first column?
        JR Z,A63174         ;YES, so hop up 1 line at far right
        DEC H               ;NO, so move cursor left 1 column
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
A63174:
        LD A,(Y_MIN)        ;A=Y min
        CP L                ;are we at the first line?
        JR Z,A63067         ;YES, so exit (can't scroll down)
        DEC L               ;NO, so move cursor up 1 line
        LD A,(X_MAX)        ;A=X max
        LD H,A              ;cursor column=X max
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
;FORM FEED ^L (12) subroutine.
;    The entire screen is erased.  The cursor is placed at the upper left
;    corner.

A63188:
        LD A,(NUM_LINES)    ;A=number of lines
        LD B,A              ;in B for counter
        LD HL,(UPPER_LEFT)  ;L=line of upper left corner, H=column
        CALL A63308         ;ERASE B LINES STARTING AT H,L subroutine
        LD A,32
        LD (OLDCHAR_),A     ;old char=space; fall into next routine
;***************************************************************************
;HOME (128) subroutine.
;    The cursor is placed at the upper left corner.

A63203
        CALL A63447         ;DISPLAY OLD CHARACTER ON SCREEN
        LD HL,(UPPER_LEFT)  ;L=line of upper left corner, H=column
        JP A63056           ;PRINT CURSOR AT NEW X,Y (H,L)
;***************************************************************************
;SYNCHRONOUS IDLE ^V (22) subroutine.
;    The physical screen line is erased from the current cursor position to
;    the end of the line.  The cursor is not moved.

A63212:
        CALL A63334         ;ERASE TO END OF CURRENT LINE subroutine
        JP A63062           ;PRINT CURSOR
;***************************************************************************
;CANCEL ^X (24) subroutine.
;    The physical screen line is erased from the current cursor position to
;    the end of the line.  All lines below the current line are also erased.
;    The cursor is not moved.

A63218:
        CALL A63334         ;ERASE TO END OF CURRENT LINE subroutine
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        INC L               ;down to next line
        LD A,(Y_MIN)        ;A=Y min
        LD C,A              ;in C
        LD A,(NUM_LINES)    ;A=number of lines
        ADD A,C             ;A=line number of last screen line
        SUB L               ;A=lines left between current and bottom
        JP Z,A63062         ;no lines left, so exit
        LD B,A              ;B=lines left (for counter)
        LD A,(X_MIN)        ;A=X min
        LD H,A              ;new cursor column at far left
        CALL A63308         ;ERASE B LINES STARTING AT H,L subroutine
        JP A63062           ;PRINT CURSOR
;***************************************************************************
;FILE SEPARATOR ^\ (28) subroutine.
;    This routine is used to "quick move" the cursor to any position on the
;    screen.  On entry, D=column (X), E=line (Y) to move to.  The cursor is
;    moved to these coordinates if they are not out of range.

A63248:
        LD A,(X_MIN)        ;A=X min
        CP D                ;is it at the left margin?
        JR Z,A63257         ;YES, so keep checking
        JP NC,A63067        ;NO, too far left (right falls through)
A63257:
        LD A,(X_MAX)        ;A=X max
        CP D                ;is it at the right margin?
        JR Z,A63266         ;YES, so keep checking
        JP C,A63067         ;NO, too far right (left falls through)
A63266:
        LD A,(Y_MIN)        ;A=Y min
        CP E                ;is it at the top?
        JR Z,A63275         ;YES, so keep checking
        JP NC,A63067        ;NO, too far up (below falls through)
A63275:
        LD A,(Y_MAX)        ;A=Y max
        CP E                ;is it at the bottom?
        JR Z,A63284         ;YES, so
        JP C,A63067         ;NO, too far down (above falls through)
A63284:
        EX DE,HL            ;HL=new cursor coordinates
        JP A63101           ;PRINT OLD CHARACTER AND PRINT CURSOR
;***************************************************************************
;FILL LINE BUFFER WITH SPACES STARTING AT HL subroutine.
;    On entry, HL=address of position in line buffer to start filling with
;    spaces, B=number of spaces to fill.  It jumps into the next routine,
;    bypassing the setup for erasing the entire buffer.

A63288:
        PUSH HL
        PUSH BC
        JR A63299
;***************************************************************************
;FILL ENTIRE LINE BUFFER WITH SPACES.

A63292:
        PUSH HL
        PUSH BC
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        LD B,32             ;number of characters to fill in buffer
A63299:
        LD A,32             ;character=space
A63301:
        LD (HL),A           ;put it in buffer
        INC HL              ;point to next slot
        DJNZ A63301         ;keep filling 'til count is zero
        POP BC
        POP HL
        RET
;***************************************************************************
;ERASE B LINES STARTING AT H,L subroutine.
;    On entry, B=number of lines to erase, HL=current cursor position.

A63308:
        CALL A63292         ;FILL ENTIRE LINE BUFFER WITH SPACES subrt
        LD A,(NUM_COLUMNS)  ;A=number of columns
        LD C,A              ;in C
A63315:
        PUSH BC             ;save it
        PUSH HL             ;save current cursor position (H,L)
        CALL A63484         ;GET VRAM ADDR OF current CURSOR X,Y IN DE
        LD B,0              ;BC=C (number of bytes to write)
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        CALL WRITE_VRAM     ;Fn78:  WRITE VRAM
        POP HL              ;restore cursor position
        INC L               ;down to next line
        POP BC              ;restore count of lines to erase
        DJNZ A63315         ;keep going until all lines are erased
        RET
;***************************************************************************
;ERASE TO END OF CURRENT LINE subroutine.

A63334:
        CALL A63353         ;READ REST OF LINE FROM VRAM INTO BUFFER
        PUSH HL             ;save line buffer start address
        PUSH BC             ;C=# of char read (from READ REST OF LINE)
        LD B,C              ;B=count of bytes to write
        CALL A63288         ;FILL LINE BUFFER WITH SPACES START AT HL
        POP BC              ;restore C=# char replaced by with spaces
        POP HL              ;restore HL=line buffer start address
        LD A,32
        LD (OLDCHAR_),A     ;old character=space
        JP WRITE_VRAM       ;Fn78:  WRITE VRAM
;***************************************************************************
;READ REST OF CURRENT LINE FROM VRAM INTO LINE BUFFER subroutine.
;    On exit, C=number of characters between the cursor and the physical end
;    of the line, and the line buffer contains those characters.

A63353:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        LD A,(X_MAX)        ;A=X max
        INC A
        SUB H               ;A=number of columns to fill with spaces
        LD C,A              ;in C
        CALL A63484         ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        LD B,0              ;BC=C (count of bytes to read)
        PUSH BC
        PUSH HL
        PUSH DE
        CALL READ_VRAM      ;Fn79:  READ VRAM
        POP DE
        POP HL
        POP BC
        RET
;***************************************************************************
;SCROLL UP 1 LINE subroutine.
;    On exit, the cursor is positioned at the lower left corner of the screen.

A63380:
        CALL A63447         ;DISPLAY OLD CHARACTER ON SCREEN subrt
        LD HL,(UPPER_LEFT)  ;L=line of upper left corner, H=column
        PUSH HL             ;save upper left corner coordinates
                            ;this is where we start copying to
        CALL A63484         ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE
        POP HL              ;get back upper left corner coordinates
        LD A,(NUM_LINES)    ;A=number of lines
        LD B,A              ;in B
        DEC B               ;one less for count
A63396:
        PUSH BC             ;save count
        PUSH DE             ;save VRAM address
        INC L               ;point to next line for source
        PUSH HL             ;save new source cursor coordinates
                            ;this is where we copy from
        CALL A63484         ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE
        PUSH DE             ;save new source VRAM address
        LD A,(NUM_COLUMNS)  ;A=number of columns
        LD C,A              ;in C
        LD B,0              ;BC=C (count of columns to read)
        PUSH BC             ;save it
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        CALL READ_VRAM      ;Fn79:  READ VRAM (current line to move)
        POP BC              ;restore BC=column read count
        POP DE              ;restore DE=source VRAM address
        POP HL              ;restore HL=source line coordinates
        EX (SP),HL          ;save this on stack
                            ;now HL=VRAM address of target line
        EX DE,HL            ;DE=VRAM address of target line
                            ;HL=source VRAM address
        PUSH HL             ;save source VRAM address
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        CALL WRITE_VRAM     ;Fn78:  WRITE VRAM (old line moved up 1)
        POP DE              ;DE=source VRAM address
                            ;this becomes target for next loop cycle
        POP HL              ;HL=source line coordinates
                            ;these become target for next loop cycle
        POP BC              ;restore count of lines to erase
        DJNZ A63396         ;decrement it and keep going 'til done
        CALL A63292         ;FILL ENTIRE LINE BUFFER WITH SPACES subrt
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        LD A,(NUM_COLUMNS)  ;A=number of columns
        LD C,A              ;B=0, so BC=A (number of bytes to write)
        JP WRITE_VRAM       ;Fn78:  WRITE VRAM (erase the last line)
;***************************************************************************
;DISPLAY OLD CHARACTER ON SCREEN subroutine.
;    This is also used to display any character in A by entry at A63450.

A63447:
        LD A,(OLDCHAR_)     ;A=old character
A63450:
        PUSH HL
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
        CALL A63484         ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE
        LD HL,LINEBUFFER_   ;HL=address of line buffer
        LD (HL),A           ;put A into line buffer
        LD BC,1             ;1 character to write
        CALL WRITE_VRAM     ;Fn78:  WRITE VRAM
        POP HL
        RET
;***************************************************************************
;READ OLD CHARACTER AT CURRENT CURSOR X,Y subroutine.
;    The result is stored at 65145.

A63469:
        LD HL,(CURSOR)      ;L=cursor line, H=cursor column
A63472:
        CALL A63484         ;GET VRAM ADDR OF CURRENT CURSOR X,Y IN DE
        LD BC,1             ;1 byte to read
        LD HL,OLDCHAR_      ;HL=address of old character
        JP READ_VRAM        ;Fn79:  READ VRAM
;***************************************************************************
;GET VRAM ADDRESS OF CURRENT CURSOR X,Y IN DE subroutine.
;    On entry, H=current cursor column, L=current cursor line.  On exit, DE=
;    VRAM address of these coordinates in the name table.  NOTE:  To use this
;    routine in 40-column text mode, it must be altered to multiply by 40
;    instead of 32.  (E.g. save L*8 and then add it to L*32.)

A63484:
        LD E,H              ;save cursor column in E
        LD H,0              ;zero out L (HL=L)
        ADD HL,HL           ;L*2
        ADD HL,HL           ;L*4
        ADD HL,HL           ;L*8
        ADD HL,HL           ;L*16
        ADD HL,HL           ;L*32
        LD D,0              ;zero out D (DE=E=saved cursor column)
        ADD HL,DE             ;HL=(32*cursor line)+cursor column
        LD DE,(PTRN_NAME_TBL) ;DE=VRAM address of name table
        ADD HL,DE             ;HL=offset address
        EX DE,HL              ;put it in DE
        RET
;***************************************************************************
;DATA TABLE OF CONTROL CHARACTERS FOR SCREEN PRINTING.

A63502:
        DB 08H       ;backspace ^H (8)
        DB 0DH       ;carriage return ^M (13)
        DB 0AH       ;line feed ^J (10)
        DB 0CH       ;form feed ^L (12)
        DB 80H       ;home (128)
        DB 16H       ;synchronous idle ^V (22)
        DB 18H       ;cancel ^X (24)
        DB 1CH       ;file separator ^\ (28)
        DB 0A0H      ;up arrow (160)
        DB 0A2H      ;down arrow (162)
        DB 0A3H      ;left arrow (163)
        DB 0A1H      ;right arrow (161)
;***************************************************************************
;VECTOR TABLE FOR PROCESSING CONTROL CHARACTERS.
;   *** Note that the vectors are in reverse order from the above table!!

A63514:
        DW A63134    ;right arrow (161)
        DW A63161    ;left arrow (163)
        DW A63107    ;down arrow (162)
        DW A63091    ;up arrow (160)
        DW A63248    ;file separator ^\ (28)
        DW A63218    ;cancel ^X (24)
        DW A63212    ;synchronous idle ^V (22)
        DW A63203    ;home (128)
        DW A63188    ;form feed ^L (12)
        DW A63107    ;line feed ^J (10)
        DW A63076    ;carriage return ^M (13)
        DW A63161    ;backspace ^H (8)
;***************************************************************************
;EOS Function 0:  EOS START/INITIALIZATION.
;    This routine is jumped to by a powerup boot program located in page 0 of
;    the SmartWriter ROM.  (When the Z80A CPU is reset, the program counter is
;    forced to 0000, and execution begins there.  ADAM is hardwired so that
;    this accesses the SmartWriter ROM.)  On entry, 8K of EOS have already
;    been copied from the EOS ROM to the upper 32K of RAM (starting at 57344).
;    The EOS ROM is still switched in as the lower 32K.  Function 0 sets up
;    the EOS stack, moves up the EOS data tables by 1 byte (why I don't know),
;    sets the revision number byte to 5, gets the I/O ports from OS-7, turns
;    off the sound, fills all 16K of VRAM with zeroes, then bank switches the
;    lower 32K to RAM.  After further setup, it tries to load a bootstrap
;    program from either disk (1, then 2) or tape (1, then 2).  If a boot is
;    successfully loaded, the routine jumps to it at 51200; otherwise, the
;    routine jumps to Function 61 (go to SmartWriter).  Note that tape 1 and
;    tape 2 share the same DCB, and the node type byte of the tape DCB shows
;    whether tape 2 is available (hex 03) or not (hex 33).

__EOS_START:
        LD SP,EOS_STACK         ;SP points to top of EOS stack
        LD BC,327               ;number of bytes to move with LDIR
        LD DE,CLEAR_RAM_START+1 ;new start of EOS RAM table
        LD HL,CLEAR_RAM_START   ;old start of EOS RAM table
        XOR A
        LD (HL),A             ;zero out old start
        LDIR                  ;move old EOS RAM table to 64865-65192
                              ;this effectively scrambles any old EOS
                              ;version which might have been in RAM
        LD A,5
        LD (REV_NUM),A        ;set EOS revision=5
        CALL PORT_COLLECTION  ;Fn75:  GET I/O PORTS FROM OS-7
        CALL TURN_OFF_SOUND   ;Fn97:  SOUND OFF
        LD A,0                ;character to fill VRAM=0
        LD HL,0               ;fill from start of VRAM
        LD DE,16384           ;16K to fill
        CALL FILL_VRAM        ;Fn82:  FILL VRAM WITH 1 CHARACTER (in A)
        LD A,(MEM_CNFG01)     ;A=memory configuration 1
                              ;lower 32K RAM, upper 32K RAM
        CALL SWITCH_MEM       ;Fn76:  BANK SWITCH MEMORY (to A)
        CALL __HARD_INIT      ;*Fn15:  HARD INITIALIZATION (COLD BOOT)
        LD DE,THREE1K_BLKS    ;DE=start of DTA block (dir, file1, file2)
        LD HL,FCB_S           ;HL=start of FCB block (0, 1, 2)
        CALL __FMGR_INIT      ;*Fn46:  INITIALIZE FILE MANAGER
        LD A,8                ;
        LD (CURRENT_DEV),A    ;current device=tape 1
        LD A,4                ;but let's try disk 1 anyway...
        CALL __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
        JR NZ,A63622          ;disk 1 doesn't exist, so try disk 2
        LD A,4                ;disk 1 available!
        CALL __FIND_DCB       ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        LD A,(IY+20)          ;A=node type from DCB
        AND 15                ;zero out upper 4 bits (get lower nibble)
        CP 3                  ;is it 3?
        LD A,4                ;restore device number
        JR C,A63688           ;less than 3 (OK), so let's read disk 1
A63622:
        LD A,5                ;3 or greater (error), so try disk 2
        CALL __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
        JR NZ,A63645          ;disk 2 doesn't exist either; try tape 1
        LD A,5                ;disk 2 available!
        CALL __FIND_DCB       ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        LD A,(IY+20)          ;A=node type from DCB
        AND 15                ;zero out upper 4 bits (get lower nibble)
        CP 3                  ;is it 3?
        LD A,5                ;restore device number
        JR C,A63688           ;less than 3 (OK), so let's read disk 2
A63645:
        LD A,8                ;3 or greater (error), so let's try tapes
        CALL __REQUEST_STATUS ;*Fn26:  REQUEST DEVICE (in A) STATUS
        JR NZ,A63682          ;no tape drives exist!!
                              ;we have no recourse but SmartWriter...
        LD A,8              ;tapes available!
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        LD A,(IY+20)        ;A=node type from DCB
        PUSH AF             ;save it
        AND 15              ;zero out upper 4 bits (get lower nibble)
        CP 3                ;is it 3?
        JR C,A63685         ;less than 3 (OK), so let's read tape 1
        POP AF              ;3 or greater (error), so let's try tape 2
                            ;restore node type byte
        SRL A               ;A/2
        SRL A               ;A/4
        SRL A               ;A/8
        SRL A               ;A/16 -- get high nibble
        CP 3                ;is it 3?
        LD A,24             ;device=tape 2
        JR C,A63688         ;less than 3 (OK), so let's read tape 2
A63682:
        JP _GOTO_WP         ;3 or greater (error), so
                            ;Fn61:  GO TO SmartWriter
;***************************************************************************
A63685:
        POP AF              ;clear stack (if necessary)
        LD A,8              ;device 8=tape 1
A63688:
        LD (CURRENT_DEV),A  ;current dev=A (enter here for other devs)
A63691:
        LD HL,COLD_START_ADDR ;HL=data transfer area for boot program
        LD BC,0               ;hiword of block to read=0
        LD A,(CURRENT_DEV)  ;A=current device
        LD DE,0             ;loword of block to read=0
        CALL __RD_1_BLK     ;*Fn19:  READ 1 BLOCK
        JP Z,A63727         ;read OK, so run the boot program at 51200
        LD C,A              ;read failed, so save error code in C
        LD A,(CURRENT_DEV)  ;A=current device
        AND 15              ;zero out upper 4 bits of device number
        CP 8                ;is it a tape? (08h=tape 1, 18h=tape 2)
        JR NZ,A63691        ;NO, so try the read again (infinite loop)
        LD A,C              ;YES, so get error code from C
        CP 155              ;is it 155?
        JR Z,A63691         ;YES, so try the read again
        JP A63682           ;NO, so roundabout jump to SmartWriter
                            ;why not just JP _GOTO_WP?
;***************************************************************************
A63727:
        LD A,(CURRENT_DEV)  ;A=current device
        LD B,A              ;B=current device
        JP COLD_START_ADDR  ;jump to block 0 program read in at 51200
;***************************************************************************
;EOS Function 15:  HARD INITIALIZATION (COLD BOOT).
;    Current PCB address is set to 65216.  After a hard reset of ADAMnet, the
;    old PCB, DCBs, and RESERVED_BYTE are zeroed out (addresses 65216-65535).
;    The Z80A and master 6801 clocks are synchronized, and ADAMnet is scanned
;    for devices, creating new DCBs as active devices are found.

__HARD_INIT:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        LD HL,PCB              ;HL=address of PCB
        LD (CURRENT_PCB),HL    ;save it in RAM
        CALL __HARD_RESET_NET  ;*Fn16:  HARD RESET ADAMnet
        CALL __DLY_AFT_HRD_RES ;*Fn4: DELAY AFTER HARD RESET
        LD HL,PCB              ;HL=current PCB address
        LD DE,PCB+1         ;DE=new PCB address
        LD BC,319           ;count of bytes to wipe
        LD (HL),0           ;zero out old PCB status byte
        LDIR                ;wipe RAM by sequential copy of zeroes
A63764:
        CALL __SYNC         ;*Fn43:  SYNCH Z80A & MASTER 6801 CLOCKS
        JR NZ,A63764        ;synch failed, but keep trying
        CALL __SCAN_ACTIVE  ;*Fn30:  SCAN ADAMnet FOR DEVICES
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 31:  SOFT INITIALIZATION (WARM BOOT).
;    On entry, HL=new PCB address.  This routine is like Function 15 (cold
;    boot) with two exceptions.  First, the new PCB address is supplied on
;    entry, not automatically set to 65216.  Second, it zeroes out the PCB
;    and the DCBs, but *not* the RESERVED_BYTE (65535).  The significance of
;    this latter difference is not clear.

__SOFT_INIT:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        LD (CURRENT_PCB),HL    ;save new PCB address=HL
        CALL __HARD_RESET_NET  ;*Fn16:  HARD RESET ADAMnet
        CALL __DLY_AFT_HRD_RES ;*Fn4: DELAY AFTER HARD RESET
        LD HL,(CURRENT_PCB)    ;HL=current PCB address
        LD E,L
        LD D,H              ;DE=HL=current PCB address
        INC DE              ;new PCB address=1 above old
        LD BC,318           ;count of bytes to move
        LD (HL),0           ;zero out first byte of old PCB
        LDIR                ;wipe RAM by sequential copy of zeroes
A63805:
        CALL __SYNC         ;*Fn43:  SYNCH Z80A & MASTER 6801 CLOCKS
        JR NZ,A63805        ;synch failed, but keep trying
        CALL __SCAN_ACTIVE  ;*Fn30:  SCAN ADAMnet FOR DEVICES
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 16:  HARD RESET ADAMnet.
;    Sends 15 out the reset port (63), waits a bit, then sends 0.

__HARD_RESET_NET:
        LD A,(NET_RESET_PORT) ;A=ADAMnet reset port (63)
        LD C,A                ;save it in C
        LD A,15
        OUT (C),A           ;send 15 out port 63
        LD A,0              ;A=0
A63829:
        NOP
        NOP
        NOP                 ;delay a bit
        DEC A               ;A=255,254,253,...
        JR NZ,A63829        ;wait for 256 idle loop cycles
        XOR A               ;A=0
        OUT (C),A           ;send 0 out port 63
        RET
;***************************************************************************
;EOS Function 4:  DELAY AFTER HARD RESET.
;    This do-nothing loop seem unnecessarily complicated, but its complexity
;    is probably due to its history.  The necessary delay time was probably
;    determined empirically, and this programming structure allows loops of
;    varying lengths to be constructed simply by changing B and DE.

__DLY_AFT_HRD_RES:
        PUSH BC
        PUSH DE
        LD B,1              ;1 time through big loop
A63843:
        LD DE,1             ;DE=1 (make bigger for longer delay)
A63846:
        DEC DE              ;DE=0 (decrement counter)
        LD A,D
        OR E                ;is DE=0?
        JR NZ,A63846        ;NO, so keep idling
        DJNZ A63843         ;YES, little loop done; is big loop done?
        POP DE              ;NO, so exit
        POP BC
        RET
;***************************************************************************
;EOS Function 43:  SYNCHRONIZE Z80A and MASTER 6801 CLOCKS.
;    On exit, ZF=1 and A=0 if synch was OK.  If synch failed, ZF=0 and A=18
;    (SYNCH1 FAILED) or A=19 (SYNCH2 FAILED).

__SYNC:
        PUSH IY
        PUSH HL
        PUSH BC
        PUSH DE
        LD IY,(CURRENT_PCB) ;IY=address of current PCB
        LD (IY+3),0         ;zero out device # byte of PCB
        LD (IY+0),1         ;request status of Z80A
        LD DE,0             ;DE=0
        LD B,2              ;number of times through status read loop
A63878:
        DEC DE              ;DE=255,254,253,...
        LD A,D
        OR E                ;is DE=0?
        JR NZ,A63893        ;NO, so read status
        LD DE,0             ;YES, so why reset it?
        DJNZ A63893         ;go through the read loop again
        LD A,18             ;A=18 (SYNCH1 FAILED error)
        OR A                ;clear ZF
        JR A63941           ;exit error
;***************************************************************************
A63893:
        LD A,(IY+0)         ;read processor status byte
        CP 129              ;is it 129? (in synch)
        JR NZ,A63878        ;NO, so keep polling until it is
        LD (IY+0),2         ;YES, so request master 6801 status
        LD DE,0             ;DE=0
        LD B,2              ;number of times through status read loop
A63909:
        DEC DE              ;DE=255,254,253,...
        LD A,D
        OR E                ;is DE=0?
        JR NZ,A63924        ;NO, so read status
        LD DE,0             ;YES, so why reset it?
        DJNZ A63924         ;go through the read loop again
        LD A,19             ;A=19 (SYNCH2 FAILED error)
        OR A                ;clear ZF
        JR A63941           ;exit error
;***************************************************************************
A63924:
        LD A,(IY+0)         ;read processor status byte
        CP 130              ;is it 130? (in synch)
        JR NZ,A63909        ;NO, so keep polling until it is
        PUSH IY             ;save PCB address...
        POP HL              ;in HL
        LD (IY+1),L
        LD (IY+2),H         ;save PCB address in PCB
        XOR A               ;A=0, ZF=1 for OK exit
A63941:
        POP DE
        POP BC
        POP HL
        POP IY
        RET
;***************************************************************************
;EOS Function 30:  SCAN ADAMnet FOR DEVICES.
;    All DCBs are zeroed.  The device count in the PCB is zeroed.  ADAMnet
;    is scanned for devices 1-15.  If the device is active (status=128), a
;    new 21-byte DCB is allocated, and the PCB device count is incremented.
;    Otherwise, scanning continues.  On exit, PCB byte 3 has the number of
;    active devices, and the DCBs follow consecutively.  Note:  tape 1
;    (device 8) and tape 2 (device 24) share the same DCB.

__SCAN_ACTIVE:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        PUSH IX
        LD HL,(CURRENT_PCB) ;HL=address of current PCB
        LD DE,4
        ADD HL,DE           ;offset to start of DCB space
        LD E,L
        LD D,H              ;DE=DCB start address...
        INC DE              ;plus 1
        LD BC,314           ;count of bytes to wipe
        LD (HL),0           ;zero out old first byte
        LDIR                ;wipe RAM by sequential copy of zeroes
        LD IY,(CURRENT_PCB) ;IY=address of current PCB
        LD DE,4
        ADD IY,DE           ;IY=DCB start address
        LD IX,(CURRENT_PCB) ;IX=address of current PCB
        LD (IX+3),1         ;add first device
        LD A,1              ;device #1=keyboard
A63990:
        PUSH AF             ;save it
        LD (IY+16),A        ;byte 16 is device #
        LD (IY+0),1         ;request status of device
A63998:
        BIT 7,(IY+0)        ;is bit 7 set? (new status ready to read?)
        JR Z,A63998         ;NO, so keep waiting for status
        LD A,(IY+0)         ;YES, so get status in A
        CP 128              ;is it 128?
        JR Z,A64022         ;YES, so add it to active list
        POP AF              ;NO, restore device #
        INC A               ;try next device
        CP 16               ;all done? (max 15)
        JR NZ,A63990        ;NO, so keep looking
        DEC (IX+3)          ;YES, so adjust device count
        JR A64039           ;exit
;***************************************************************************
A64022:
        INC (IX+3)          ;one more active device
        LD DE,21            ;length of DCB=21
        ADD IY,DE           ;offset to start of next DCB
        POP AF              ;restore device #
        INC A               ;try next device
        CP 16               ;all done? (max=15)
        JR NZ,A63990        ;NO, so keep looking
        DEC (IX+3)          ;YES, so adjust device count
A64039:
        POP IX
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 25:  RELOCATE PCB (to HL).
;    On entry, HL=new address of PCB.

__RELOC_PCB:
        PUSH IY
        LD IY,(CURRENT_PCB) ;IY=address of current PCB
        LD (IY+1),L
        LD (IY+2),H         ;save new PCB address in old PCB
        LD (IY+0),3         ;request relocation
A64063:
        LD A,(IY+0)         ;read status
        CP 131              ;is it 131? (relocate finished)
        JR NZ,A64063        ;NO, so keep reading
        LD (CURRENT_PCB),HL ;YES, so save new PCB address
        POP IY
        RET
;***************************************************************************
;EOS Function 14:  GET PCB ADDRESS (in IY).
;    On exit, IY=current PCB address.

__GET_PCB_ADDR:
        LD IY,(CURRENT_PCB) ;IY=address of current PCB
        RET
;***************************************************************************
;EOS Function 33:  SOFT RESET KEYBOARD.

__SOFT_RES_KBD:
        LD A,1              ;1=keyboard
        JR __SOFT_RES_DEV   ;*Fn32:  SOFT RESET DEVICE (in A)
;***************************************************************************
;EOS Function 34:  SOFT RESET PRINTER.

__SOFT_RES_PR:
        LD A,2              ;2=printer
        JR __SOFT_RES_DEV   ;*Fn32:  SOFT RESET DEVICE (in A)
;***************************************************************************
;EOS Function 35:  SOFT RESET TAPE.

__SOFT_RES_TAPE:
        LD A,8              ;8=tape 1/2
        JR __SOFT_RES_DEV   ;*Fn32:  SOFT RESET DEVICE (in A)
                            ;omit this!
;***************************************************************************
;EOS Function 32:  SOFT RESET DEVICE (in A).
;    On entry, A=device number.  On exit, A=128 and ZF=1 if device is reset
;    and ready for use.  ZF=0 if device doesn't exist or is busy.

__SOFT_RES_DEV:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64120        ;device doesn't exist; error exit
        CALL A62614         ;CHECK IF DEVICE (IN A) IS READY subrt
        JR NZ,A64120        ;in use, so error exit
        LD (IY+0),2         ;request reset of device (IY=DCB address)
A64109:
        BIT 7,(IY+0)        ;is status code ready to read yet?
        JR Z,A64109         ;NO (bit 7 clear) so keep waiting
        LD A,(IY+0)         ;YES, so get status in A
        CP 128              ;it 128? (reset and ready for use)
A64120:
        POP IY
        RET
;***************************************************************************
;EOS Function 21:  READ KEYBOARD STATUS BYTE.

__RD_KBD_RET_CODE:
        LD A,1              ;1=keyboard
        JR __RD_RET_CODE    ;*Fn23:  READ DEVICE (in A) STATUS BYTE
;***************************************************************************
;EOS Function 22:  READ PRINTER STATUS BYTE.

__RD_PR_RET_CODE:
        LD A,2              ;2=printer
        JR __RD_RET_CODE    ;*Fn23:  READ DEVICE (in A) STATUS BYTE
;***************************************************************************
;EOS Function 24:  READ TAPE STATUS BYTE.

__RD_TAPE_RET_CODE:
        LD A,8              ;8=tape 1/2
        JR __RD_RET_CODE    ;*Fn23:  READ DEVICE (in A) STATUS BYTE
                            ;omit this!
;***************************************************************************
;EOS Function 23:  READ DEVICE (in A) STATUS BYTE.
;    On entry, A=device number.  On exit, if the device does not exist, ZF=0.
;    Otherwise, ZF=1 and A=status byte from DCB.

__RD_RET_CODE:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64145        ;device dosn't exist; error exit
        LD A,(IY+0)         ;A=status byte
A64145:
        POP IY
        RET
;***************************************************************************
;EOS Function 61:  GO TO SmartWriter.
;    Bank switches to the SmartWriter ROM, then jumps to the first byte of
;    code at address 256.

__GOTO_WP:
        LD A,(MEM_CNFG00)   ;A=memory configuration 0
                            ;lower 32K=SmartWriter ROM, upper 32K=RAM
        CALL SWITCH_MEM     ;Fn76:  BANK SWITCH MEMORY (to A)
        JP 256              ;jump to first byte of SmartWriter code
;***************************************************************************
;EOS Function 62:  READ EOS.
;    Not implemented in EOS-5.  Presumably this routine was intended to read
;    in a fresh copy of the current operating system from the EOS ROM (which
;    can hold up to 4 different 8K EOS versions).  A user program not needing
;    EOS routines could use the space for itself, then restore EOS when done.
;    Perhaps.

__READ_EOS:
        RET

;    Note added 9508.08:  the EOS6 source has the following interesting note,
;    followed by a block of commented-out code.  Here are both note and code
;    in their entirety:

;    CODE FROM HERE TO END OF EOS_UTIL WAS INSERTED AFTER THE
;    REV. 06 ROM WAS BURNED.  IT HAS BEEN COMMENTED OUT TO MAINTAIN
;    COMPATIBILITY WITH THAT ROM.
;
;     END
;
;EOS_CODE_START  EQU  00800H
;EOS_SIZE        EQU  02000H-800H
;EOS_DEST        EQU  0E000H+800H
;
;     LD A,0                      ;BANK SWITCH IN THE BOOT ROMS
;     OUT (7FH),A                 ; (I HOPE)
;
;     LD HL,EOS_CODE_START        ;WHERE DOES EOS SIT IN BOOT ROMS
;     LD DE,EOS_DEST              ;WHERE EOS GOES
;     LD BC,EOS_SIZE              ;HOW BIG EOS IS
;     LDIR                        ;MOVE EOS INTO PLACE
;
;     LD A,3                      ;BANK SWITCH IN OS_7
;     OUT (7FH),A                 ; (I KNOW)
;
;     RET

;    The amazing things about this code are that
;    (1) it doesn't copy all of EOS (it skips the first 2048 bytes);
;    (2) if it's supposed to be copying EOS-5, it starts in the middle of the
;        file I/O routines (address 59392);
;    (3) it ends by bank-switching in OS-7/24K RAM for the low 32K.

;    The only possible explanations are that
;    (1) it's a hook for Super Games, which need EOS block I/O routines,
;        but which use OS-7 for video and sound; or
;    (2) it's expecting an ADAM with a different version of EOS in ROM.
;        EOS-7 is almost but not quite 2K shorter than EOS-5; perhaps it
;        was anticipated that it would be shorter in the release version.

;***************************************************************************
;EOS Function 19:  READ 1 BLOCK.
;    On entry, A=device number, BCDE=block number to read (BC=hiword, DE=
;    loword), HL=data transfer address (DTA).  On exit, ZF=1 if read was
;    successful, ZF=0 if not.

__RD_1_BLK:
        PUSH IY
        PUSH AF                 ;save device #
        CALL __START_RD_1_BLOCK ;*Fn38:  START READ 1 BLOCK
        JR NZ,A64173            ;start failed, error exit ZF=0
A64166:
        POP AF                  ;restore device #
        PUSH AF                 ;save it again
        CALL __END_RD_1_BLOCK   ;*Fn7:  END READ 1 BLOCK
        JR NC,A64166            ;not done reading, so keep waiting
A64173:
        POP IY              ;we're done, so pop AF off stack without
                            ;destroying current flags
        POP IY
        RET
;***************************************************************************
;EOS Function 44:  WRITE 1 BLOCK.
;    On entry, A=device number, BCDE=block number to write (BC=hiword, DE=
;    loword), HL=data transfer address (DTA).  On exit, ZF=1 if write was
;    successful, ZF=0 and A=error code if not.

__WR_1_BLOCK:
        PUSH IY
        PUSH AF                 ;save device #
        CALL __START_WR_1_BLOCK ;*Fn41:  START WRITE 1 BLOCK
        JR NZ,A64193            ;start failed, error exit ZF=0
A64186:
        POP AF                  ;restore device #
        PUSH AF                 ;save it again
        CALL __END_WR_1_BLOCK   ;*Fn10:  END WRITE 1 BLOCK
        JR NC,A64186            ;not done writing, so keep waiting
A64193:
        POP IY              ;we're done, so pop AF off stack without
                            ;destroying current flags
        POP IY
        RET
;***************************************************************************
;EOS Function 38:  START READ 1 BLOCK.
;    On entry, A=device number, BCDE=block number to read (BC=hiword, DE=
;    loword), HL=data transfer address (DTA).  On exit, ZF=1 if start was
;    successful, ZF=0 and A=error code (1=NON-EXISTENT DEVICE, 2=DEVICE NOT
;    READY) if not.

__START_RD_1_BLOCK:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64220        ;device doesn't exist, error exit ZF=0
        CALL A62614         ;CHECK IF DEVICE (IN A) IS READY subrt
        JR NZ,A64220        ;device not ready, so error exit ZF=0
        CALL A64312         ;SET UP DCB FOR I/O OPERATION subrt
        LD (IY+0),4         ;request read
A64220:
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 7:  END READ 1 BLOCK.
;    On entry, A=device number.  On exit, CF=1 if the I/O attempt has ended,
;    with ZF=1 for ended successfully, ZF=0 for I/O error.  If I/O is still
;    in progress, CF=0.  Error codes in A may be 1=NON-EXISTENT DEVICE, 3=
;    I/O NOT DONE. (Exit from bit 7 clear test has A=0, which usually means
;    OK.)

__END_RD_1_BLOCK:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        SCF                 ;set CF
        JR NZ,A64252        ;device doesn't exist, error exit ZF=0
        CALL A62638         ;CHECK IF DEVICE I/O IS DONE subroutine
        JR NZ,A64252        ;I/O not done, so error exit ZF=0, CF=0
        OR A                ;I/O done, CF=0 (already clear from subrt)
        BIT 7,(IY+0)        ;is bit 7 of DCB status byte set?
        JR Z,A64252         ;NO, so error exit ZF=1, CF=0
        LD A,(IY+0)         ;A=status byte
        CP 128              ;is it 128? (successfully ended)
        SCF                 ;set CF
A64252:
        POP IY
        RET
;***************************************************************************
;EOS Function 41:  START WRITE 1 BLOCK.
;    On entry, A=device number, BCDE=block number to write (BC=hiword, DE=
;    loword), HL=data transfer address (DTA).  On exit, ZF=1 if start was
;    successful, ZF=0 and A=error code if not.

__START_WR_1_BLOCK:
        PUSH BC
        PUSH DE
        PUSH HL
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64277        ;device doesn't exist, error exit ZF=0
        CALL A62614         ;CHECK IF DEVICE (IN A) IS READY subrt
        JR NZ,A64277        ;device not ready, so error exit ZF=0
        CALL A64312         ;SET UP DCB FOR I/O OPERATION subrt
        LD (IY+0),3         ;request write
A64277:
        POP IY
        POP HL
        POP DE
        POP BC
        RET
;***************************************************************************
;EOS Function 10:  END WRITE 1 BLOCK.
;    On entry, A=device number.  On exit, CF=1 if the I/O attempt has ended,
;    with ZF=1 if successful, ZF=0 for I/O error. If I/O is still in progress,
;    CF=0.  Error codes in A may be 1=NON-EXISTENT DEVICE, 3=I/O NOT DONE.
;    (Exit from bit 7 clear test has A=0, which usually means OK.)

__END_WR_1_BLOCK:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        SCF                 ;set CF
        JR NZ,A64309        ;device doesn't exist, so error exit ZF=0
        CALL A62638         ;CHECK IF DEVICE I/O IS DONE subroutine
        JR NZ,A64309        ;I/O not done, so error exit ZF=0, CF=0
        OR A                ;I/O done, CF=0 (already cleared by subrt)
        BIT 7,(IY+0)        ;is bit 7 of DCB status byte set?
        JR Z,A64309         ;NO, so error exit ZF=1, CF=0
        LD A,(IY+0)         ;A=status byte
        CP 128              ;is it 128? (successfully ended)
        SCF                 ;set CF
A64309:
        POP IY
        RET
;***************************************************************************
;SET UP DCB FOR I/O OPERATION subroutine.
;    On entry, A=device #, BCDE=block number to access (BC=hiword, DE=loword),
;    HL=data transfer address (DTA), IY=DCB address.  The transfer buffer
;    length (DCB bytes 4-3) is set to the maximum length (bytes 18-17).  BCDE
;    is copied to bytes 8-5, HL is copied to bytes 2-1.  While byte 3 is set
;    to the device number, byte 9 contains the upper nibble of the device
;    number.  This is how one DCB is made to function for both tape 1 (device
;    hex 08) and tape 2 (device hex 18).  Note, however, that disk 1 and disk
;    2 have separate DCBs.

A64312:
        PUSH AF             ;save device #
        SRL A               ;A/2
        SRL A               ;A/4
        SRL A               ;A/8
        SRL A               ;A/16   new A=upper nibble of entry A
        LD (IY+9),A         ;put it in the DCB
        LD A,(IY+17)        ;lobyte maximum buffer length...
        LD (IY+3),A         ;...is lobyte DTA length
        LD A,(IY+18)        ;hibyte maximum buffer length...
        LD (IY+4),A         ;...is hibyte DTA length
        LD (IY+5),E         ;loword,lobyte of block number=E
        LD (IY+6),D         ;loword,hibyte=D
        LD (IY+7),C         ;hiword,lobyte=C
        LD (IY+8),B         ;hiword,hibyte=B
        LD (IY+1),L         ;loword DTA start=L
        LD (IY+2),H         ;hiword DTA start=H
        POP AF              ;restore device #
        RET
;***************************************************************************
;UNUSED EOS FUNCTION:  READ FROM CHARACTER DEVICE (IN A).
;    This routine is not found in the jump table, though whether by intention
;    (i.e., it doesn't work) or oversight I don't know.  It is the complement
;    to Function 45 (write character device (in A)).  On entry, A=device
;    number, DE=buffer start address, BC=buffer length.  On exit, ZF=1 and A=0
;    if read successful, ZF=0 and A=error code (1,2,3) if not.

A64356:
        LD (DEVICE_ID),A       ;device number=A
        CALL __START_RD_CH_DEV ;Fn39:  START READ CHARACTER DEVICE (in A)
        JR NZ,A64372           ;read failed, so EXIT ZF=0 (try RET NZ?)
A64364:
        LD A,(DEVICE_ID)       ;restore device number in A
        CALL __END_RD_CH_DEV   ;Fn8:  END READ CHARACTER DEVICE (in A)
        JR NC,A64364           ;not done yet, so keep reading
A64372:
        RET
;***************************************************************************
;EOS Function 45:  WRITE CHARACTER DEVICE (in A).
;    On entry, A=device number, HL=buffer start address, BC=buffer length.
;    On exit, ZF=1 and A=0 if write was successful, ZF=0 and A=error code
;    (1,2,3) if not.

__WR_CH_DEV:
        LD (DEVICE_ID),A       ;device number=A
        CALL __START_WR_CH_DEV ;*Fn42: start write character dev (in A)
        JR NZ,A64389           ;write failed, so EXIT ZF=0 (try RET NZ?)
A64381:
        LD A,(DEVICE_ID)       ;restore device number in A
        CALL __END_WR_CH_DEV   ;*Fn10:  END WRITE CHARACTER DEVICE (in A)
        JR NC,A64381           ;not done yet, so keep writing
A64389:
        RET
;***************************************************************************
;EOS Function 39:  START READ CHARACTER DEVICE (in A).
;    On entry, A=device number, DE=buffer start address, BC=buffer length.
;    On exit, ZF=1 and A=0 if start was OK.  Otherwise, ZF=0 and A=error code
;    (1,2).

__START_RD_CH_DEV:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64418        ;device doesn't exist, error exit ZF=0
        CALL A62614         ;CHECK IF DEVICE (IN A) IS READY subrt
        JR NZ,A64418        ;device not ready, so error exit ZF=0
        LD (IY+1),E         ;device ready! now set up DCB
        LD (IY+2),D         ;buffer start address=DE
        LD (IY+3),C
        LD (IY+4),B         ;buffer length=BC
        LD (IY+0),4         ;request read
A64418:
        POP IY
        RET
;***************************************************************************
;EOS Function 8:  END READ CHARACTER DEVICE (in A).
;    On entry, A=device number.  On exit, CF=1 if the I/O attempt has ended,
;    with ZF=1 for ended successfully, ZF=0 for I/O error.  If I/O is still
;    in progress, CF=0.  Error codes in A may be 1=NON-EXISTENT DEVICE, 3=
;    I/O NOT DONE.  (Exit from bit 7 clear test has A=0, which usually means
;    OK.)

__END_RD_CH_DEV:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        SCF                 ;set CF
        JR NZ,A64447        ;device doesn't exist, exit ZF=0, CF=1
        CALL A62638         ;CHECK IF DEVICE I/O IS DONE subroutine
        JR NZ,A64447        ;not done, so error exit ZF=0, CF=0
        OR A                ;clear CF (already cleared by DONE subrt)
        BIT 7,(IY+0)        ;is bit 7 of status byte set?
        JR Z,A64447         ;NO, so error exit ZF=1, CF=0
        LD A,(IY+0)         ;YES, so get status byte in A
        CP 128              ;is it 128? (end successful)
        SCF                 ;set CF
A64447:
        POP IY
        RET
;***************************************************************************
;EOS Function 42:  START WRITE CHARACTER DEVICE (in A).
;    On entry, A=device number, HL=buffer start address, BC=buffer length.
;    On exit, ZF=1 and A=0 if start was OK.  Otherwise, ZF=0 and A=error code
;    (1,2).

__START_WR_CH_DEV:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        JR NZ,A64478        ;device doesn't exist, so error exit ZF=0
        CALL A62614         ;CHECK IF DEVICE (IN A) IS READY subrt
        JR NZ,A64478        ;device not ready, so error exit ZF=0
        LD (IY+3),C         ;device ready! now set up DCB
        LD (IY+4),B         ;buffer length=BC
        LD (IY+1),L
        LD (IY+2),H         ;buffer start=HL
        LD (IY+0),3         ;request write
A64478:
        POP IY
        RET
;***************************************************************************
;EOS Function 11:  END WRITE CHARACTER DEVICE (in A).
;    On entry, A=device number.  On exit, CF=1 if the I/O attempt has ended,
;    with ZF=1 for ended successfully, ZF=0 for I/O error.  If I/O is still
;    in progress, CF=0.  Error codes in A may be 1=NON-EXISTENT DEVICE, 3=
;    I/O NOT DONE.  (Exit from bit 7 clear test has A=0, which usually means
;    OK.)

__END_WR_CH_DEV:
        PUSH IY
        CALL __FIND_DCB     ;*Fn12/13:  FIND/GET DCB ADDRESS (in IY)
        SCF                 ;set CF
        JR NZ,A64507        ;device doesn't exist, exit ZF=0, CF=1
        CALL A62638         ;CHECK IF DEVICE I/O IS DONE subroutine
        JR NZ,A64507        ;not done, so error exit ZF=0, CF=0
        OR A                ;clear CF (already cleared by DONE subrt)
        BIT 7,(IY+0)        ;is bit 7 of status byte set?
        JR Z,A64507         ;NO, so error exit ZF=1, CF=0
        LD A,(IY+0)         ;get status byte
        CP 128              ;is it 128? (end successful)
        SCF                 ;set CF
A64507:
        POP IY
        RET
;***************************************************************************
;UNUSED DATA?

A64510:
        DB 255
;***************************************************************************

EOS_GLB_TBL:

;***************************************************************************
;INTERRUPT VECTOR TABLE.
;    This table is used to set up page zero during the powerup boot routine
;    found in the SmartWriter ROM.

INT_VCTR_TBL:

VECTOR_08H:
        RET        ;RST 08H
        DW 0
VECTOR_10H:
        RET        ;RST 10H
        DW 0
VECTOR_18H:
        RET        ;RST 18H
        DW 0
VECTOR_20H:
        RET        ;RST 20H
        DW 0
VECTOR_28H:
        RET        ;RST 28H
        DW 0
VECTOR_30H:
        RET        ;RST 30H
        DW 0
VECTOR_38H:
        RET        ;RST 38H     ;shouldn't this be RETI?
        DW 0
VECTOR_66H:
        RETN       ;NMI routine
        DB 0
;***************************************************************************
;MEMORY CONFIGURATION TABLE:
;    In order to select the SmartWriter ROM, an OUT (63),0 must be executed
;    first.  To select the EOS ROM, use OUT (63),2.

SWITCH_TABLE:

;                  lower 32K            upper 32K
MEM_CNFG00:
        DB 0    ;SmartWriter or EOS     RAM
MEM_CNFG01:
        DB 1    ;RAM                    RAM
MEM_CNFG02:
        DB 2    ;expansion RAM          RAM
MEM_CNFG03:
        DB 3    ;OS-7 plus 24K RAM      RAM
MEM_CNFG04:
        DB 4    ;SmartWriter or EOS     expansion ROM
MEM_CNFG05:
        DB 5    ;RAM                    expansion ROM
MEM_CNFG06:
        DB 6    ;expansion RAM          expansion ROM
MEM_CNFG07:
        DB 7    ;OS-7 plus 24K RAM      expansion ROM
MEM_CNFG08:
        DB 8    ;SmartWriter or EOS     expansion RAM
MEM_CNFG09:
        DB 9    ;RAM                    expansion RAM
MEM_CNFG0A:
        DB 10   ;expansion RAM          expansion RAM
MEM_CNFG0B:
        DB 11   ;OS-7 plus 24K RAM      expansion RAM
MEM_CNFG0C:
        DB 12   ;SmartWriter or EOS     cartridge ROM
MEM_CNFG0D:
        DB 13   ;RAM                    cartridge ROM
MEM_CNFG0E:
        DB 14   ;expansion RAM          cartridge ROM
MEM_CNFG0F:
        DB 15   ;OS-7 plus 24K RAM      cartridge ROM
;***************************************************************************
;I/O PORTS.

PORT_TABLE:

MEM_SWITCH_PORT:
        DB 7FH        ;memory switch port      (127)
NET_RESET_PORT:
        DB 3FH        ;ADAMnet reset port      (63)
VDP_CTRL_PORT:
        DB 0BFH       ;VDP control port        (191)
VDP_DATA_PORT:
        DB 0BEH       ;VDP data port           (190)
CONTROLLER_0_PORT:
        DB 0FCH       ;game controller 1 port  (252)
CONTROLLER_1_PORT:
        DB 0FFH       ;game controller 2 port  (255)
STROBE_SET_PORT:
        DB 80H        ;strobe set port         (128)
STROBE_RESET_PORT:
        DB 0C0H       ;strobe reset port       (192)
SOUNDPORT:
        DB 0FFH       ;sound port              (255)
;***************************************************************************
;EOS JUMP TABLE:  EOS FUNCTIONS 0-100.
;    Function names (with modification) from "The Hacker's Guide to ADAM
;    Volume I" by Peter and Ben Hinkle (1986).
;    Function labels from Coleco's EOS6 source code.

EOS_JMP_TBL:

_EOS_START:
        JP __EOS_START         ;0    EOS START/INITIALIZATION
_CONS_DISP:
        JP __CONS_DISP         ;1    CONSOLE DISPLAY OF NON-CONTROL CHAR (in A)
_CONS_INIT:
        JP __CONS_INIT         ;2    CONSOLE INITIALIZATION
_CONS_OUT:
        JP __CONS_OUT          ;3    DISPLAY CHAR (in A) ON SCREEN (CTRL OR NOT)
_DLY_AFT_HRD_RES:
        JP __DLY_AFT_HRD_RES   ;4    DELAY AFTER HARD RESET
_END_PR_BUFF:
        JP __END_PR_BUFF       ;5    END PRINT BUFFER (at HL)
_END_PR_CH:
        JP __END_PR_CH         ;6    END PRINT CHARACTER (in A)
_END_RD_1_BLOCK:
        JP __END_RD_1_BLOCK    ;7    END READ 1 BLOCK
_END_RD_CH_DEV:
        JP __END_RD_CH_DEV     ;8    END READ CHARACTER DEVICE (in A)
_END_RD_KBD:
        JP __END_RD_KBD        ;9    END READ KEYBOARD
_END_WR_1_BLOCK:
        JP __END_WR_1_BLOCK    ;10   END WRITE 1 BLOCK
_END_WR_CH_DEV:
        JP __END_WR_CH_DEV     ;11   END WRITE CHARACTER DEVICE (in A)
_FIND_DCB:
        JP __FIND_DCB          ;12   FIND DCB
_GET_DCB_ADDR:
        JP __GET_DCB_ADDR      ;13   GET DCB ADDRESS (in IY)
_GET_PCB_ADDR:
        JP __GET_PCB_ADDR      ;14   GET PCB ADDRESS (in IY)
_HARD_INIT:
        JP __HARD_INIT         ;15   HARD INITIALIZATION (COLD BOOT)
_HARD_RESET_NET:
        JP __HARD_RESET_NET    ;16   HARD RESET ADAMnet
_PR_BUFF:
        JP __PR_BUFF           ;17   PRINT BUFFER (at HL)
_PR_CH:
        JP __PR_CH             ;18   PRINT CHARACTER (in A)
_RD_1_BLOCK:
        JP __RD_1_BLK          ;19   READ 1 BLOCK
_RD_KBD:
        JP __RD_KBD            ;20   READ KEYBOARD
_RD_KBD_RET_CODE:
        JP __RD_KBD_RET_CODE   ;21   READ KEYBOARD STATUS BYTE
_RD_PR_RET_CODE:
        JP __RD_PR_RET_CODE    ;22   READ PRINTER STATUS BYTE
_RD_RET_CODE:
        JP __RD_RET_CODE       ;23   READ DEVICE (in A) STATUS BYTE
_RD_TAPE_RET_CODE:
        JP __RD_TAPE_RET_CODE  ;24   READ TAPE STATUS BYTE
_RELOC_PCB:
        JP __RELOC_PCB         ;25   RELOCATE PCB (to HL)
_REQUEST_STATUS:
        JP __REQUEST_STATUS    ;26   REQUEST DEVICE (in A) STATUS
_REQ_KBD_STAT:
        JP __REQ_KBD_STAT      ;27   REQUEST KEYBOARD STATUS
_REQ_PR_STAT:
        JP __REQ_PR_STAT       ;28   REQUEST PRINTER STATUS
_REQ_TAPE_STAT:
        JP __REQ_TAPE_STAT     ;29   REQUEST TAPE STATUS
_SCAN_ACTIVE:
        JP __SCAN_ACTIVE       ;30   SCAN ADAMnet FOR DEVICES
_SOFT_INIT:
        JP __SOFT_INIT         ;31   SOFT INITIALIZATION (WARM BOOT)
_SOFT_RES_DEV:
        JP __SOFT_RES_DEV      ;32   SOFT RESET DEVICE (in A)
_SOFT_RES_KBD:
        JP __SOFT_RES_KBD      ;33   SOFT RESET KEYBOARD
_SOFT_RES_PR:
        JP __SOFT_RES_PR       ;34   SOFT RESET PRINTER
_SOFT_RES_TAPE:
        JP __SOFT_RES_TAPE     ;35   SOFT RESET TAPE
_START_PR_BUFF:
        JP __START_PR_BUFF     ;36   START PRINT BUFFER (at HL)
_START_PR_CH:
        JP __START_PR_CH       ;37   START PRINT CHARACTER (in A)
_START_RD_1_BLOCK:
        JP __START_RD_1_BLOCK  ;38   START READ 1 BLOCK
_START_RD_CH_DEV:
        JP __START_RD_CH_DEV   ;39   START READ CHARACTER DEVICE (in A)
_START_RD_KBD:
        JP __START_RD_KBD      ;40   START READ KEYBOARD
_START_WR_1_BLOCK:
        JP __START_WR_1_BLOCK  ;41   START WRITE 1 BLOCK
_START_WR_CH_DEV:
        JP __START_WR_CH_DEV   ;42   START WRITE CHARACTER DEVICE (in A)
_SYNC:
        JP __SYNC              ;43   SYNCHRONIZE Z80A AND MASTER 6801 CLOCKS
_WR_1_BLOCK:
        JP __WR_1_BLOCK        ;44   WRITE 1 BLOCK
_WR_CH_DEV:
        JP __WR_CH_DEV         ;45   WRITE CHARACTER DEVICE (in A)
_FMGR_INIT:
        JP __FMGR_INIT         ;46   INITIALIZE FILE MANAGER
_INIT_TAPE_DIR:
        JP __INIT_TAPE_DIR     ;47   INITIALIZE DIRECTORY
_OPEN_FILE:
        JP __OPEN_FILE         ;48   OPEN FILE
_CLOSE_FILE:
        JP __CLOSE_FILE        ;49   CLOSE FILE
_RESET_FILE:
        JP __RESET_FILE        ;50   RESET FILE
_MAKE_FILE:
        JP __MAKE_FILE         ;51   CREATE FILE
_QUERY_FILE:
        JP __QUERY_FILE        ;52   FIND FILE (WITH TYPE)
_SET_FILE:
        JP __SET_FILE          ;53   UPDATE DIRECTORY ENTRY
_READ_FILE:
        JP __READ_FILE         ;54   READ FILE
_WRITE_FILE:
        JP __WRITE_FILE        ;55   WRITE FILE
_SET_DATE:
        JP __SET_DATE          ;56   SET CURRENT DATE
_GET_DATE:
        JP __GET_DATE          ;57   GET CURRENT DATE
_RENAME_FILE:
        JP __RENAME_FILE       ;58   RENAME FILE
_DELETE_FILE:
        JP __DELETE_FILE       ;59   DELETE FILE
_RD_DEV_DEP_STAT:
        JP __RD_DEV_DEP_STAT   ;60   READ DEVICE (in A) NODE TYPE
_GOTO_WP:
        JP __GOTO_WP           ;61   GO TO SmartWriter
_READ_EOS:
        JP __READ_EOS          ;62   READ EOS [not implemented in EOS-5]
_TRIM_FILE:
        JP __TRIM_FILE         ;63   TRIM FILE
_CHECK_FCB:
        JP __CHECK_FCB         ;64   CHECK IF FILE IS OPEN
_READ_BLOCK:
        JP __READ_BLOCK        ;65   READ BLOCK
_WRITE_BLOCK:
        JP __WRITE_BLOCK       ;66   WRITE BLOCK
_MODE_CHECK:
        JP __MODE_CHECK        ;67   CHECK FILE I/O MODE
_SCAN_FOR_FILE:
        JP __SCAN_FOR_FILE     ;68   READ DIRECTORY FOR FILE
_FILE_QUERY:
        JP __FILE_QUERY        ;69   FIND FILE (NO TYPE)
_POSIT_FILE:
        JP __POSIT_FILE        ;70   POSITION FILE [not implemented in EOS-5]
_EOS_1:
        JP __EOS_1             ;71   EOS1 [not implemented in EOS-5]
_EOS_2:
        JP __EOS_2             ;72   EOS2 [not implemented in EOS-5]
_EOS_3:
        JP __EOS_3             ;73   EOS3 [not implemented in EOS-5]
_CV_A:
        JP __CV_A              ;74   INCORRECT EOS VERSION ERROR
PORT_COLLECTION:
        JP __PORT_COLLECTION   ;75   GET I/O PORTS FROM OS-7
SWITCH_MEM:
        JP __SWITCH_MEM        ;76   BANK SWITCH MEMORY (to A)
PUT_ASCII:
        JP __PUT_ASCII         ;77   PUT ASCII CHARACTER PATTERN TO VDP
WRITE_VRAM:
        JP __WRITE_VRAM        ;78   WRITE VRAM
READ_VRAM:
        JP __READ_VRAM         ;79   READ VRAM
WRITE_REGISTER:
        JP __WRITE_REGISTER    ;80   WRITE VDP REGISTER 0-7
READ_REGISTER:
        JP __READ_REGISTER     ;81   READ VDP REGISTER 8
FILL_VRAM:
        JP __FILL_VRAM         ;82   FILL VRAM WITH 1 CHARACTER (in A)
INIT_TABLE:
        JP __INIT_TABLE        ;83   INITIALIZE VRAM TABLE
PUT_VRAM:
        JP __PUT_VRAM          ;84   PUT TABLE TO VRAM
GET_VRAM:
        JP __GET_VRAM          ;85   GET TABLE FROM VRAM
CALC_OFFSET:
        JP __CALC_OFFSET       ;86   CALCULATE OFFSET INTO SPRITE ATTRIB TABLE
PX_TO_PTRN_POS:
        JP __PX_TO_PTRN_POS    ;87   POINT TO PATTERN POSITION
LOAD_ASCII:
        JP __LOAD_ASCII        ;88   LOAD ASCII CHARACTER SET FROM ROM TO VDP
WR_SPR_ATTRIBUTE:
        JP __WR_SPR_ATTRIBUTE  ;89   WRITE VRAM SPRITE ATTRIBUTE TABLE
POLLER:
        JP __POLLER            ;90   READ GAME CONTROLLERS
UPDATE_SPINNER:
        JP __UPDATE_SPINNER    ;91   UPDATE SPINNER 1 AND 2
DECLSN:
        JP __DECLSN            ;92   DECREMENT LOW NIBBLE OF (HL)
DECMSN:
        JP __DECMSN            ;93   DECREMENT HIGH NIBBLE OF (HL)
MSNTOLSN:
        JP __MSNTOLSN          ;94   HIGH NIBBLE OF (HL) TO LOW NIBBLE
ADD816:
        JP __ADD816            ;95   ADD A TO WORD AT HL
SOUND_INIT:
        JP __SOUND_INIT        ;96   SOUND INITIALIZATION
TURN_OFF_SOUND:
        JP __TURN_OFF_SOUND    ;97   SOUND OFF
PLAY_IT:
        JP __PLAY_IT           ;98   START VOICE
SOUNDS:
        JP __SOUNDS            ;99   SOUND
EFFECT_OVER:
        JP __EFFECT_OVER       ;100  END SPECIAL EFFECT NOTE
;***************************************************************************
;UNUSED DATA?

        DB 255
;***************************************************************************

EOS_GLB_RAM:
CLEAR_RAM_START:

;***************************************************************************
;VIDEO AND MEMORY DATA.

REV_NUM:
        DS 1    ;EOS revision number

VDP_MODE_WORD:
VDP_REG_0:
        DS 1    ;current contents of VDP register 0
VDP_REG_1:
        DS 1    ;current contents of VDP register 1

VDP_STATUS_BYTE:
        DS 1    ;VDP status byte

VRAM_ADDR_TABLE:
SPRITEATTRTBL:
        DS 2    ;VRAM address of sprite attribute table
SPRITEGENTBL:
        DS 2    ;VRAM address of sprite generator table
PATTRNNAMETBL:
        DS 2    ;VRAM address of pattern name table
PATTRNGENTBL:
        DS 2    ;VRAM address of pattern generator table
COLORTABLE:
        DS 2    ;VRAM address of color table

CUR_BANK:
        DS 1    ;current memory configuration (from last bank switch)
;***************************************************************************
;FILE CONTROL DATA.

DEFAULT_BT_DEV:
CURRENT_DEV:
        DS 1    ;current device number
CURRENT_PCB:
        DS 2    ;address of current PCB
DEVICE_ID:
        DS 1    ;device number
FILE_NAME_ADDR:
        DS 2    ;address of filename string
KEYBOARD_BUFFER:
        DS 1    ;keyboard buffer (last key pressed)
PRINT_BUFFER:
        DS 16   ;printer buffer
SECTORS_TO_INIT:
        DS 1    ;number of blocks to initialize
SECTOR_NO:
        DS 4    ;block to initialize
DCB_IMAGE:
        DS 21   ;DCB image [not used in EOS-5]
QUERY_BUFFER:
        DS 26   ;query buffer
FCB_BUFFER:
        DS 26   ;FCB buffer
FILE_COUNT:
        DS 1    ;file count
MOD_FILE_COUNT:
        DS 1    ;mod file count
RETRY_COUNT:
        DS 1    ;retry count
FILE_NUMBR:
        DS 1    ;file number
FILENAME_CMPS:
        DS 1    ;file name comparison status byte
                ;(0=name and file type must match, anything
                ;else=only name must match)
DIR_BLOCK_NO:
        DS 2    ;directory block number
FOUND_AVAIL_ENT:
        DS 1    ;found entry status byte
                ;(1=matching entry found, 0 if not)
BLK_STRT_PTR:
VOL_BLK_SZ:
        DS 4    ;volume block size [not used in EOS-5]
EOS_YEAR:
        DS 1    ;current file creation year
EOS_MONTH:
        DS 1    ;current file creation month
EOS_DAY:
        DS 1    ;current file creation day
FMGR_DIR_ENT:
        DS 26   ;file manager directory entry [not used in EOS-5]
FCB_HEAD_ADDR:
        DS 2    ;address of FCB0 (FCB1 offset 35, FCB2 offset 70)
FCB_DATA_ADDR:
        DS 2    ;address of DTA0 (DTA1 offset 1024, DTA2 offset 2048)
FNUM:
        DS 1    ;file number (01 or 02)
BYTES_REQ:
        DS 2    ;bytes requested to read/write
BYTES_TO_GO:
        DS 2    ;bytes left to read/write
USER_BUF:
        DS 2    ;read/write buffer address
BUF_START:
        DS 2    ;buffer start address
BUF_END:
        DS 2    ;buffer end address
BLOCKS_REQ:
        DS 4    ;file length in blocks
USER_NAME:
        DS 2    ;filename string address
START_BLOCK:
        DS 4    ;start block [not used in EOS-5]
NEW_HOLE_START:
        DS 4    ;new hole start block
NEW_HOLE_SIZE:
        DS 2    ;new hole size in blocks
;***************************************************************************
;EOS STACK.

STACK_START:
        DS 60   ;bottom to top of EOS stack
EOS_STACK:

;***************************************************************************
;GAME CONTROLLER DATA.
;    This seemingly illogical setup was verified by examining SmartBASIC's
;    PDL routines.  "The Hacker's Guide to ADAM Volume I" is incorrect on
;    this point--they are clearly following the ColecoVision Technical
;    Manual here.  The game controller data structures are different between
;    EOS and OS-7.

SPIN_SW0_CT:
        DS 1    ;spinner player 1
SPIN_SW1_CT:
        DS 1    ;spinner player 2
PERSONAL_DEBOUNCE_TABLE:
        DS 1    ;joystick player 2
        DS 1    ;left button player 2
        DS 1    ;right button player 2
        DS 1    ;keypad player 2
        DS 1    ;joystick player 1
        DS 1    ;left button player 1
        DS 1    ;right button player 1
        DS 1    ;keypad player 1
;***************************************************************************
;TEMPORARY STACK USED BY FUNCTION 77:  PUT ASCII CHARACTER TO VDP.

        DS 12   ;bottom to top -- at maximum usage, stack contains:

        ;65132-33   old stack pointer
        ;65130-31   old memory configuration and flags
        ;65128-29   return address 57726 after call to Fn78
        ;65126-27   BC register saved by Fn78
        ;65124-25   return addr 57349 after call to ENABLE VRAM WRITE
        ;65122-23   0000 (unused)

TEMP_STACK:

;***************************************************************************
;SOUND DATA.

PTR_TO_LST_OF_SND_ADDRS:
        DS 2   ;address of voice table
PTR_TO_S_ON_0:
        DS 2   ;address of noise output table
PTR_TO_S_ON_1:
        DS 2   ;address of voice 1 output table
PTR_TO_S_ON_2:
        DS 2   ;address of voice 2 output table
PTR_TO_S_ON_3:
        DS 2   ;address of voice 3 output table
SAVE_CTRL:
        DS 1   ;saved control sound
;***************************************************************************
;VIDEO DISPLAY DATA.
;    Note:  SmartBASIC does not use this space, since it does not call EOS
;    to display characters.

OLDCHAR_:
        DS 1   ;old character (at current cursor position)
X_MIN:
        DS 1   ;X min (column)
X_MAX:
        DS 1   ;X max (column)
Y_MIN:
        DS 1   ;Y min (line)
Y_MAX:
        DS 1   ;Y max (line)
LINEBUFFER_:
        DS 33  ;line buffer
NUM_LINES:
        DS 1   ;number of lines
NUM_COLUMNS:
        DS 1   ;number of columns
UPPER_LEFT:
        DS 1   ;screen upper left corner line (Y)
        DS 1   ;screen upper left corner column (X)
PTRN_NAME_TBL:
        DS 2   ;address of name table
CURSOR:
        DS 1   ;current cursor position line (Y)
        DS 1   ;current cursor column (X)
;***************************************************************************
;DATA UNUSED IN EOS-5.
;    This space was reserved for future versions of EOS.  Some of it is used
;    in EOS-7.

        DB 0
        DS 24
;***************************************************************************

EOS_PCB_DCB:

;***************************************************************************
;PROCESSOR CONTROL BLOCK (PCB).
;    The PCB is a 4-byte block, usually at address 65216 but relocatable, used
;    by the master 6801 ADAMnet controller to keep track of devices.

PCB:
        DS 1   ;processor status byte
        DS 2   ;address of PCB start (65216)
        DS 1   ;number of active devices (number of DCBs)

;    Reading byte 0 returns status information from ADAMnet; the meaning of
;    individual status bits is uncertain.  Writing to byte 0 requests the
;    following operations:

;data              function
; 1   synchronize the Z80 clock
; 2   synchronize the master 6801 clock
; 3   relocate PCB
;***************************************************************************
;DEVICE CONTROL BLOCKS (DCBs).
;    Each DCB is 21 bytes long, with a maximum of 15 devices, in ascending
;    order of primary device number.  (Device numbers may be greater than 15,
;    however.  See tape DCB.)  The number of DCBs depends upon how many valid
;    devices were attached to ADAMnet at startup.

;offset                    meaning
;   0     status byte
; 1-2     buffer start address (lobyte, hibyte)
; 3-4     buffer length (lobyte, hibyte)
; 5-8     block number accessed (loword, hiword in lobyte, hibyte format)
;   9     high nibble of device number
;10-15    always zero (unknown purpose)
;  16     device number
;17-18    maximum block length (lobyte, hibyte)
;  19     device type (0 for block device, 1 for character device)
;  20     node type (see Function 60 for details)

;    Reading byte 0 returns status information from ADAMnet; the meaning of
;    individual status bits is uncertain.  Empirically, anything with bit 7
;    clear means that nothing has happened yet (the command is still being
;    processed); 80h means success, 9Bh means timeout (i.e. there is no
;    ADAMnet device corresponding to the device number you were trying to
;    access), anything else is some kind of error or not-ready condition.

;    Writing to byte 0 requests the following operations:

;data            function
; 1     return current status
; 2     soft reset
; 3     write
; 4     read

;    ADAMnet device numbers decode as follows:

;number                   device                         type
;  0         master 6801 ADAMnet controller               -
;  1         keyboard                                     1
;  2         ADAM printer                                 1
;  3         Copywriter                                   1 ??
;  4         disk drive 1                                 0
;  5         disk drive 2                                 0
;  6         disk drive 3                                 0
;  7         disk drive 4                                 0
;  8         tape drive 1                                 0
;  9         tape drive 3                                 0
; 10         -- unused --                                 -
; 11         Non-ADAMlink modem                           1 ??
; 12         Hi-resolution monitor                        1 ??
; 13         ADAM parallel interface                      1
; 14         ADAM serial interface                        1
; 15         Gateway                                     ???
; 24         tape drive 2                                 0
; 25         tape drive 4                                 0
; 26         expansion RAM disk drive                     -

;Device Notes:
;     0      The master 6801 uses the PCB as its DCB.
;     3      Projected dot matrix printer?
;   6,7      Third-party modified disk drive EPROMs to change ADAMnet device
;            ID.
;  8,24      Tape 1 and tape 2 share the same DCB.
;  9,25      Projected.  Tape3 and tape 4 would have shared the same DCB.
; 11,12      Projected but probably never designed or built.
;    13      The prototype ADAM parallel interface, never released.
;            SmartBASIC 2.0 has routines to access it as PR #4.
;    14      The prototype ADAM serial interface, never released.  Smart-
;            BASIC 2.0 has routines to access it as IN #2 and PR #2.
;    15      This always appears as the last DCB, and always with a not-
;            ready status (see __SCAN_ACTIVE code).  Presumably would have
;            been used to network ADAMs via ADAMnet.
;    26      Used as a third-party RAMdisk device ID.  Not used by Coleco.
;            Probably derived from an error in interpreting SmartBASIC 1.0's
;            drive-to-device table.  1A hex is the first byte of code after
;            the table, which only has entries for D1-D6.  The fetch routine,
;            however, accepts D7, so it returns code as data.
;***************************************************************************
DCBS:
        DS 15*21    ;DCBs
;***************************************************************************
RESERVED_BYTE:
        DS 1        ;reserved byte for "fast DMA" (unimplemented)

;This is the end of EOS (address 65535, 0FFFFh).

;***************************************************************************

;EOS DIRECTORY STRUCTURE.

;     Each entry consists of 26 bytes.  Directories begin at block 1, and may
;be up to 255 blocks long.  Entries for files have the following format:

;bytes  0-11   Filename specification.  A valid filename consists of up to 10
;              characters, followed by a type byte, terminated with hex 03.
;              The type byte can be A, a, H, or h (ASCII or hex, lowercase for
;              backups).
;         12   File attribute.  Set bits in the attribute byte map as follows:
;                   0   not a file (used for BLOCKS LEFT)
;                   1   execute protected (can't be opened for execution)
;                   2   deleted file
;                   3   system file (hidden from SmartBASIC CATALOG)
;                   4   user file
;                   5   read-protected
;                   6   write-protected (read only)
;                   7   delete protected
;      13-16   Start block.  Stored loword, hiword.
;      17-18   Allocated length.  Includes any unused "holes" which may be
;              tacked on at the end.
;      19-20   Used length.  Actual length of file, discounting unused "holes"
;              at the end.
;      21-22   Number of bytes used in last allocated block of file.  Thus, to
;              compute file length in bytes, (allocated-used-1)*1024+lastbyte.
;         23   Creation year.  There is no set rule for how to represent the
;              year.  One common method is (year-1900); thus 1987 would be hex
;              57.  This wastes the values hex 00-53 (since ADAM appeared in
;              1983).  I propose that these be interpreted as (year+2000).
;         24   Creation month.  Range hex 01-0C.
;         25   Creation day.  Range hex 01-1F.

;     Four special entries are found in the directory of every EOS disk.  The
;first three are always:

;     VOLUME.       bytes  0-11   volume name
;                            12   attribute=hex 80 (delete protected)
;                         13-16   hex 55AA00FF directory check for EOS format
;                         17-18   disk size in blocks
;     BOOT.         bytes  0-11   BOOT
;                            12   attribute=hex 88 (delete protected, system
;                                 file)
;                         17-18   allocated length=1 block
;                         19-20   used length=1 block
;                         21-22   lastbyte=0 (means 1024, i.e. the whole block)
;     DIRECTORY.    bytes  0-11   DIRECTORY
;                            12   attribute=hex C8 (delete and write pretected,
;                                 system file)
;                         13-16   start block (default=1)
;                         17-18   maximum size of directory in blocks
;                         19-20   current size of directory in blocks

;     The last entry of every directory in EOS-5 is:

;     BLOCKS LEFT.  bytes  0-11   BLOCKS LEFT
;                            12   attribute=hex 01 (not a file)
;                         13-16   first free block in largest contiguous
;                                 cluster of free blocks at the end of the
;                                 storage medium
;                         17-18   total number of free blocks (contiguous or
;                                 not)
;                         19-20   used length always 0
;                         23-25   EOS version date=hex 570711
;                                 This date does not conform to the pattern
;                                 described above.  In "The Hacker's Guide To
;                                 ADAM Vol. II", Ben Hinkle suggests that this
;                                 should be read as 7/11/1957, perhaps the
;                                 birthdate of one of the programmers.

;     Note:  EOS-7 does not use BLOCKS LEFT to keep track of free blocks.
                 
;***************************************************************************
;EOS FILE CONTROL BLOCK (FCB) STRUCTURE.

;     EOS sets up areas of RAM to store data about open files, called file
;control blocks (FCBs).  EOS-5 has 3 FCBs:  1 for the system, and 2 for user
;files (3 in EOS-7).  FCBs are contiguous 35-byte blocks set up as follows:

;     bytes  0-22   from EOS directory entry (no date bytes)
;              23   EOS device # using the FCB
;              24   I/O mode byte.  The set bits are mapped as follows:
;                        7   current block in buffer is the last block
;                            of the file
;                        6   data in buffer is waiting to be written
;                            to the file.  Makes EOS write the data
;                            before loading a new block into the buffer.
;                        5   file won't reuse deleted file space
;                        4   unused
;                        3   unused
;                        2   open for execute
;                        1   open for write
;                        0   open for read
;                   Bits 5,2,1,0 are set by the caller; bits 7,6 are set
;                   and used internally by EOS.  Files can be opened for
;                   read, write, read-write or execute; an error results
;                   if read, write and execute are simultaneously set.
;           25-28   current block for I/O. Loword, hiword.
;           29-32   last block of file.  Loword, hiword.
;           33-34   address of I/O buffer (DTA).  This area is also used in
;                   EOS-7 by Fn70 (POSITION FILE) and Fn50 (RESET FILE) to
;                   store the byte offset into the current DTA.
;
;******************************************************************************
;EOS ERROR CODES.
;     These are returned in A with ZF=0 upon return after an error.  I have
;selected likely names based upon what seems to be going wrong when they are
;issued.  In some cases, I have provided alternate names which may be more
;meaningful or explanatory.  The recently-obtained "ADAM Technical Manual"
;(Coleco, 1984) lists the actual assembly symbols used for these errors.

; code                 meaning                        Coleco symbol

;  [0   No Error]                                          ---
;   1   Non-Existent Device                           DCB_NOT_FOUND
;   2   Device Not Ready                              DCB_BUSY
;   3   I/O Not Done (I/O Not Over)                   DCB_IDLE_ERR
;   4   No Date Set                                   NO_DATE_ERR
;   5   No More Directory (File Not Found)  [Fn68]    NO_FILE_ERR
;       File Not Open [Fn64]
;   6   File Already Exists                           FILE_EXISTS_ERR
;   7   Too Many Open Files                           NO_FCB_ERR
;   8   Match Not Found                               MATCH_ERR
;   9   Bad File Number                               BAD_FNUM_ERR
;  10   I/O Past End                                  EOF_ERR
;  11   File Too Big                                  TOO_BIG_ERR
;  12   Directory Full                                FULL_DIR_ERR
;  13   No More Room (Disk Full)                      FULL_TAPE_ERR
;  14   Bad File Name                                 FILE_NM_ERR
;  15   [unused; see error 5]                         RENAME_ERR
;  16   File Locked (File Write Protected)            DELETE_ERR
;  17   Bad I/O Mode                                  RANGE_ERR
;  18   Synch 1 Failed                                CANT_SYNC1
;  19   Synch 2 Failed                                CANT_SYNC2
;  20   File Access Denied                            PRT_ERR
;  21   [unknown, unimplemented]                      RQ_TP_STAT_ERR
;  22   I/O Error                                     DEVICE_DEPD_ERR
;  23   Incorrect EOS Version                         PROG_NON_EXIST
;  24   Non-EOS Volume                                NO_DIR_ERR

;Error notes:

;   5,15   Due to a possible typographical error by a programmer, two
;          different errors are allocated to 5, while 15 is unused.
;          Since SmartBASIC treats 5 as "File Not Found", this suggests
;          that "File Not Open" should have been 15.
;      7   SmartBASIC calls this "No Buffers Available".
;  12,13   SmartBASIC does not differentiate between these, lumping them
;          both together as "No More Room".
;     20   PRT_ERR means "Protected Error".
;     21   RQ_TP_STAT_ERR means "Request Tape Status Error".  It appears
;          only in an orphaned code fragment.
;     22   DEVICE_DEPD_ERR means "Device-Dependent Error".

;***************************************************************************